|
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中名称略有不同）。
回到Excel主界面，还是在开发工具选项卡中，点击“宏”，选中刚才编辑的这个宏命令，单击“运行”，这时Excel会自动弹出文件选择框，找到要摘录信息的Word文档点选打开，Excel就可以开始自动摘录信息了。这样一来，数据摘录的工作就完全依靠电脑自动完成了，大大节省了工作时间，也避免了手工摘录的出错几率。
|
