The following Excel macro should do as you want:
Sub GetTableData()
'Note: this code requires a reference to the Word object model.
'See under the VBE's Tools|References.
Application.ScreenUpdating = False
Dim wdApp As New Word.Application, wdDoc As Word.Document, wdTbl As Word.Table
Dim strFolder As String, strFile As String, WkBk As Workbook, WkSht As Worksheet
Dim StrTbl As String, r As Long, i As Long, j As Long
strFolder = GetFolder: If strFolder = "" Then GoTo ErrExit
Set WkBk = ActiveWorkbook
'Disable any auto macros in the documents being processed
wdApp.WordBasic.DisableAutoMacros
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
Set wdDoc = wdApp.Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
Set WkSht = WkBk.Sheets.Add: r = 1
WkSht.Name = Split(strFile, ".doc")(0)
With wdDoc
For Each wdTbl In .Tables
With wdTbl.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[^13^l]"
.Replacement.Text = "¶"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
If r > 1 Then r = r + 2: i = r
wdTbl.Range.Copy
WkSht.Paste Destination:=WkSht.Range("C" & r)
StrTbl = wdTbl.Range.Paragraphs.First.Previous.Range.Text
r = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
For j = i To r
WkSht.Range("A" & r).Value = Split(strFile, ".")(0)
WkSht.Range("B" & r).Value = StrTbl
Next
Next
WkSht.UsedRange.Replace What:="¶", Replacement:=Chr(10), LookAt:=xlPart, SearchOrder:=xlByRows
.Close SaveChanges:=False
End With
strFile = Dir()
Wend
ErrExit:
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing: Set WkBk = Nothing
Application.ScreenUpdating = True
End Sub
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
Simply select the folder to process. The macro creates a new worksheet for each document and outputs all tables from that document one below the other, with an empty row in between. Except for text wrapping, table formatting is preserved as much as possible.
If you don't want a new worksheet for each document, delete:
Set WkSht = WkBk.Sheets.Add: r = 1
WkSht.Name = Split(strFile, ".doc")(0)
change:
Set WkBk = ActiveWorkbook
to:
Set WkBk = ActiveWorkbook: Set WkSht = WkBk.ActiveSheet
and change:
Dim StrTbl As String, r As Long, i As Long, j As Long
to:
Dim StrTbl As String, r As Long, i As Long, j As Long: r = 1