利用excel的VBA汇总多个word中的表格数据

yifand

我在工作中，经常需要调查一些人员的信息数据，把制作好的word表格发下去（用QQ或是电子邮件传给他们），他们填好后再反馈回来。这样就会收到很多的word表格（可能会有好几百个），然后需要把这些表格中的数据统计出来。如果逐一打开这些word表格，采用粘贴、复制的办法，把word表格内的数据一一导入到excel中，工程量大且容易出现疏漏，如何利用简单的办法快速统计出结果呢？
利用excel中的“宏”可以很好的解决这个问题，经过编写vba程序，现将我的结果拿出来和大家一同分享，愿和我有类似工作的朋友少走弯路。也请高手多多指点。

“宏”中的VBA内容附在下面：
Private Sub CommandButton1_Click()
    [a2:t300].ClearContents
    Application.ScreenUpdating = False
    F = Dir(ThisWorkbook.Path & "\" & "*.doc")
    Set WDAP = New Word.Application
    i = 2
    Do Until F = ""
        F = ThisWorkbook.Path & "\" & F
        Set WD = WDAP.Documents.Open(Filename:=F)
        With WD
            st = .Paragraphs(3).Range.Text
            Cells(i, 1) = Trim(Left(st, Len(st) - 2))
            st = .Paragraphs(5).Range.Text
            Cells(i, 2) = Trim(Left(st, Len(st) - 2))
            st = .Paragraphs(9).Range.Text
            Cells(i, 3) = Trim(Left(st, Len(st) - 2))
            st = .Paragraphs(11).Range.Text
            Cells(i, 4) = Trim(Left(st, Len(st) - 2))
            st = .Paragraphs(15).Range.Text
            Cells(i, 5) = Trim(Left(st, Len(st) - 2))
            st = .Paragraphs(17).Range.Text
            Cells(i, 6) = Trim(Left(st, Len(st) - 2))
            st = .Paragraphs(21).Range.Text
            Cells(i, 7) = Trim(Left(st, Len(st) - 2))
            st = .Paragraphs(25).Range.Text
            Cells(i, 8) = Trim(Left(st, Len(st) - 2))
            st = .Paragraphs(29).Range.Text
            Cells(i, 9) = Trim(Left(st, Len(st) - 2))
            st = .Paragraphs(31).Range.Text
            Cells(i, 10) = Trim(Left(st, Len(st) - 2))
            st = .Paragraphs(34).Range.Text
            Cells(i, 11) = Trim(Left(st, Len(st) - 2))
            st = .Paragraphs(36).Range.Text
            Cells(i, 12) = Trim(Left(st, Len(st) - 2))
            st = .Paragraphs(39).Range.Text
            Cells(i, 13) = Trim(Left(st, Len(st) - 2))
            st = .Paragraphs(41).Range.Text
            Cells(i, 14) = Trim(Left(st, Len(st) - 2))
            st = .Paragraphs(44).Range.Text
            Cells(i, 15) = Trim(Left(st, Len(st) - 2))
            st = .Paragraphs(46).Range.Text
            Cells(i, 16) = Trim(Left(st, Len(st) - 2))
            st = .Paragraphs(49).Range.Text
            Cells(i, 17) = Trim(Left(st, Len(st) - 2))
            st = .Paragraphs(51).Range.Text
            Cells(i, 18) = Trim(Left(st, Len(st) - 2))
            st = .Paragraphs(54).Range.Text
            Cells(i, 19) = Trim(Left(st, Len(st) - 2))
            st = WDAP.ActiveDocument.Tables(1).Cell(12, 2)
            Cells(i, 20) = Trim(Left(st, Len(st) - 2))
        End With
        Set WD = Nothing
        F = Dir
        i = i + 1
    Loop
    WDAP.Quit
    Set WDAP = Nothing
    Application.ScreenUpdating = True
End Sub
程序到此为止。
应用的时候，把压缩包中的文件拷到一个单独的文件夹中，只需要打开excel文件，单击“开关”按钮，好多word文档中的数据就自动汇总到excel中啦。（注：“开关”按钮在excel文件的第1行第W列）

[ 本帖最后由 yifand 于 2010-6-1 09:37 编辑 ]

FXSHENG

这个都能做，学习，感谢分享！

lrlxxqxa

谢谢楼主，你的方法很有价值。关于在excel调用word汇总的方法我还是第一次见到，确实不错

江海渔生

下一个学习一下，谢谢

hc2266116

谢谢分享!
下一个留用!

飞云楼主

这种汇总方法很新鲜，收下学习。

lnlyhsn

这种汇总方法很新鲜，收下学习。

aroffice

学习了，下一个来~！！！

Anson4

收下学习了，感谢分享！

wenwen000424

学习并支持一下,谢谢分享.