Get all data from word table into excel

[blanchard306]

I'm trying to get this code to extract all the table data from the word files in the folder location and put them into the same excel sheet. The part of the code in blue (or sh1.Cells(x,2)) is where i'm having trouble changing it to capture all table data not just one row of data from the word file. Thanks for any help you can give i'm a bit new to all this.

Sub extractwordtables()

Dim wrdDoc As Object, objFiles As Object, fso As Object, wordApp As Object
Dim sh1 As Worksheet
Dim x As Integer

  FolderName = "C:\code" ' Change this to the folder containing your word documents
  
  Set sh1 = ThisWorkbook.Sheets(1)
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set wordApp = CreateObject("Word.application")
  Set objFiles = fso.GetFolder(FolderName).Files
  
  x = 1
  For Each wd In objFiles
      If InStr(wd, ".docx") And InStr(wd, "~") = 0 Then
      Set wrdDoc = wordApp.Documents.Open(wd.Path, ReadOnly = True)
      sh1.Cells(x, 1) = wd.Name
      sh1.Cells(x, 2) = Application.WorksheetFunction.Clean(wrdDoc.Tables(3).Cell(Row:=3, Column:=2).Range)
      
      x = x + 1
      wrdDoc.Close
    End If
    
  Next wd
  wordApp.Quit
End Sub

[SamT]

Using an Integer for a row assignment can fail.

[snb]

sub M_snb()
   sn=filter(split(createobject("wscript.shell").exec("cmd /c Dir G:\Of\*.docx /b").stdout.readall,vbcrlf),"~",false)

   for each it in sn
      With GetObject("G:\OF\" & it )
         .tables(1).Range.Copy
         Sheet1.Paste Sheet1.Cells(rows.count,1).end(xlup).offset(2)
         .close 0
      End With
    next
End Sub