使用Excel自动摘录数据方法(2)
Word部分就设置完毕了，这时候可以将文件发送给被收集信息者，待返回后，开始用Excel批量自动摘录Word填表信息。打开Excel，同样是切换到开发工具选项卡，点选最左侧的“Visual Basic”。
双击Sheet1，填写宏代码(登录PC版微信，订阅号中找到办公便签，点击查看历史消息找到本文再进行复制)：
Option Base 1
Sub readDoc()
Dim WordApp As Word.Application
Set WordApp = CreateObject("Word.Application")
Dim WordDoc As Word.Document
Dim diag1 As FileDialog
Dim return1 As String
Dim filePathArray()
Set diag1 = Application.FileDialog(msoFileDialogFilePicker)
"定义文件选择对话框
With diag1
.AllowMultiSelect = True "设置文件选择对话框能够选择多个文件
return1 = .Show "打开文件选择对话框
n = .SelectedItems.Count "将选中文件个数保存至变量n
If return1 = -1 Then
"如选中文件(retun1=-1)则将选中的文件路径保存到filePathArray数组
ReDim filePathArray(n)
For i = 1 To n
filePathArray(i) = .SelectedItems(i)
Next
Else "如果未选中任何文件则提示
MsgBox "未选择任何文件", vbExclamation
End If
End With
For j = 1 To n
Set WordDoc = WordApp.Documents.Open(filePathArray(j))
"根据filePathArray数组中的路径逐个打开Word文件
Dim ccSet
Set ccSet = WordDoc.ContentControls
"将ccSet设为打开文档的内容控件集合
i = 1
For Each cc In ccSet "遍历所有内容控件
Application.ActiveSheet.Cells(j, i) = cc.Range.Text "将内容控件内容保存至单元格
i = i + 1
Next
WordDoc.Close "关闭当前Word文档
Next
WordApp.Quit
End Sub
注意，抄录好宏代码后，不要着急关闭，点选当前Visual Basic界面上方工具栏的“工具—引用”，在“可使用的引用”中找到“Microsoft Word 16.0 Object Library”并勾选确定(Word2013中名称略有不同)。
