Sub 汇总()

    Application.ScreenUpdating = False

    Set wd = CreateObject("word.application") '建立对Word程序的引用

    p = "c:\test\"'word文件目录,根据实际修改

    f = Dir(p & "*.doc*")'

    r = 1

    Do

        r = r + 1

        Set d = wd.documents.Open(p & f) '建立对Word文件的引用

        With d.tables(1)

            Cells(r, 1) = d.Name  '获取当前Word文件名

            Cells(r, 2) = .cell(2, 4).Range.Text

            '上一行将word文档第一个表格第2行第4列的数据存入当前工作表的A列

        End With

        d.Close '关闭Word文件

        f = Dir

     Loop Until f = ""

     wd.Quit

     Set wd = Nothing '清空对象

     Application.ScreenUpdating = True

End Sub