Help needed: Retrieve tables in word and copy them to Excel

Rz1986

Hello everyone,

I have been assigned a task at work to write a VBA for automation. We have many word documents in a folder that have hundreds of tables within them. I want to create an automation program that is going to retrieve tables from the word document specified and go through the document table by table copying these tables into a separate Excel sheet named after the document itself. As I have never worked with VBA before I was able to get code that finds the tables in a word document but I want the program to create a loop that can copy these tables into a spreadsheet. So far I have this

Sub findTable()
Dim iResponse As Integer
Dim tTable As Table

' Dim ExcelSheet
' Set ExcelSheet = CreateObject("Excel.Application") trying to get an excel sheet open
' ExcelSheet.Visible = True

'If any tables exist, loop through each table in collection.
For Each tTable In ActiveDocument.Tables
tTable.Select
Selection.Copy
ExcelSheet.Workbooks.Open ActiveDocument.Path & Application.PathSeparator & "test.xls"
' ThisWorkbook.Activate
' Workbooks.Open "D:\Profiles\RIZWANHA\Desktop\FrameMaker files\test.xls"
Selection.Paste

'iResponse = MsgBox("Table found. Find next ", 68)
'If response = vbNo Then Exit For 'User chose to leave search.
Next
MsgBox prompt:="Search Complete.", buttons:=vbInformation
End Sub

I am getting errors when I try pasting into the excel spreadsheet. Your help will be appreciated.

Thanks

bi-lya

Hi!

See this:

Code Block

Sub findTable()
  Dim tTable As Table
  Dim ExcelApp As Excel.Application
  Dim ExcelWB As Excel.Workbook
  Set ExcelApp = CreateObject("Excel.Application")
  Set ExcelWB = ExcelApp.Workbooks.Open("c:\test.xls")
  'ExcelApp.Visible = True
      
  For Each tTable In ActiveDocument.Tables
    a = a + 1
    With ExcelWB
      If a > .Worksheets.Count Then .Worksheets.Add After:=.Worksheets(a - 1)
      tTable.Range.Copy
      .Worksheets(a).Paste Destination:=.Worksheets(a).Range("a1")
    End With
  Next
  
  MsgBox prompt:="Search Complete.", buttons:=vbInformation
  
  ExcelApp.Quit
  Set ExcelWB = Nothing
  Set ExcelApp = Nothing
End Sub

Don't forget to link up Excel as reference and use Application.ScreenUpdating

Rz1986

Oh Great !!! Thanks a lot bu-lya. You fixed a big issue for me. But is there a way to paste all the tables into one worksheet in test.xls. Leaving maybe a space between each table.

Thanks again, really appreciate your time and help!

bi-lya

Code Block

a = 1
For Each tTable In ActiveDocument.Tables
tTable.Range.Copy
With ExcelWB.Worksheets(1)
.Paste Destination:=.Cells(a, 1)
End With
a = a + tTable.Rows.Count + 2
Next

Help needed: Retrieve tables in word and copy them to Excel

Re: Help needed: Retrieve tables in word and copy them to Excel

Re: Help needed: Retrieve tables in word and copy them to Excel

Re: Help needed: Retrieve tables in word and copy them to Excel