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




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

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






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

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!






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

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