All,

I'm trying to modify some code that extracts the first table from each word document in a folder and places it into excel. What I would like to achieve is to have the macro extract all of the tables from each word document and place them into excel. The issue lies with the code specifying a single table (oDoc.Tables(1).Range.Cells) and I can't seem to figure out how to modify the code so that it will extract all of the tables in each word document (I've tried looping it another way, but I'm not very experienced with VBA).

Any help would be greatly appreciated. Again, the code is perfect except for the fact that it only takes the first table from each document as opposed to all of the tables from each document.

Code:

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