vba 将 Word 文档数据导入 Excel（多个文档）
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/18970224/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Importing Word Document Data into Excel (Multiple Documents)
提问by Arc'
All,
全部，
How can I modify the code below to not just grab the first table of each word document in a specific folder but to extract all of the tables from each document? I've tried manipulating the code myself but I can't seem to get it right. Any help would be greatly appreciated.
如何修改下面的代码，不仅要抓取特定文件夹中每个 word 文档的第一个表格，还要从每个文档中提取所有表格？我尝试过自己操作代码，但似乎无法正确操作。任何帮助将不胜感激。
Option Explicit
Sub test()
Dim oWord As Word.Application
Dim oDoc As Word.Document
Dim oCell As Word.Cell
Dim sPath As String
Dim sFile As String
Dim r As Long
Dim c As Long
Dim Cnt As Long
Application.ScreenUpdating = False
Set oWord = CreateObject("Word.Application")
sPath = "C:\Users\Domenic\Desktop\" 'change the path accordingly
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sFile = Dir(sPath & "*.doc")
r = 2 'starting row
c = 1 'starting column
Cnt = 0
Do While Len(sFile) > 0
Cnt = Cnt + 1
Set oDoc = oWord.Documents.Open(sPath & sFile)
For Each oCell In oDoc.Tables(1).Range.Cells
Cells(r, c).Value = Replace(oCell.Range.Text, Chr(13) & Chr(7), "")
c = c + 1
Next oCell
oDoc.Close savechanges:=False
r = r + 1
c = 1
sFile = Dir
Loop
Application.ScreenUpdating = True
If Cnt = 0 Then
MsgBox "No Word documents were found...", vbExclamation
End If
End Sub
回答by Tim Williams
Dim tbl
'........
Set oDoc = oWord.Documents.Open(sPath & sFile)
For each tbl in oDoc.Tables
For Each oCell In tbl.Range.Cells
Cells(r, c).Value = Replace(oCell.Range.Text, Chr(13) & Chr(7), "")
c = c + 1
Next oCell
r = r + 2 'couple of blank rows between tables
c = 1
Next tbl
oDoc.Close savechanges:=False
'.........
