PDA

View Full Version : Importing Tables From Word Into Excel Spreadsheet Cells



Ealcmhar
09-12-2012, 06:02 PM
Hi,

I'm trying to copy the data contained within tables in a Word document (*.docm) and export it into Excel, however I seem to have no success.

I've tried using this code:
Sub importwordtoexcel()

'Import all tables to a single sheet
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Word
Dim jRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
wdFileName = Application.GetOpenFilename("Word files (*.docm),*.docm", , _
"Browse for file containing table to be imported")
If wdFileName = False Then Exit Sub '(user cancelled import file browser)
Set wdDoc = GetObject(wdFileName) 'open Word file
With wdDoc
If wdDoc.Tables.Count = 0 Then
MsgBox "This document contains no tables", _
vbExclamation, "Import Word Table"
Else
jRow = 0
For TableNo = 1 To wdDoc.Tables.Count
With .Tables(TableNo)
'copy cell contents from Word table cells to Excel cells
For iRow = 1 To .Rows.Count
jRow = jRow + 1
For iCol = 1 To .Columns.Count
On Error Resume Next
Sheets("Teams").Cells(jRow, iCol) = WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text)
On Error GoTo 0
Next iCol
Next iRow
End With
jRow = jRow + 1
Next TableNo
End If
End With
Set wdDoc = Nothing
End Sub

however have had no success in producing results. I copied the code from another thread (dubbed "export word tables into excel") and inserted it into VBA under "Modules", and haven't encountered any errors in running it (I can choose to open a document with tables), however nothing is inserted into the active speadsheet.

Any assistance would be happily appreciated. :thumb

Tinbendr
09-13-2012, 06:19 AM
Comment out the 'On error Resume Next' and see what error it's generating.

snb
09-13-2012, 08:12 AM
- adapt the file's fullname

Sub snb()
With GetObject("G:\OF\__tabel kopie in Excel.docm")
if.tables.count>0 Then
.tables(1).Range.Copy
ThisWorkbook.Sheets(1).Paste ThisWorkbook.Sheets(1).Cells(1)
End if
.Close 0
End With
End Sub

Ealcmhar
09-14-2012, 04:27 AM
Thanks for the quick responses. :thumb

@ Tinbendr
When I commented out 'On error Resume Next'', I received the following error message:
Run-time error '9':

Subscript out of range

@ snb
Is the sub intended to be used intact, or do I replace the included file address ("G:\OF\__tabel kopie in Excel.docm") with that of the word document I'd like to extract the table(s) from? I tried replacing the file address with that of the word document with tables in it, although received the following message:
Run-time error:

File name or class name not found during Automation operation

snb
09-14-2012, 06:07 AM
Like I indicated you have to fill in the full path & name of your Word file.

Tinbendr
09-14-2012, 06:42 AM
I tried your code on some word tables I have and it ran fine.

Run it again and hover over each side of the statement to determine if the error is on the Excel side or Word side.

SNB's code is indicating to pull the whole table in at once instead of iterating each cell.

Ealcmhar
09-15-2012, 04:31 AM
@ snb
Ah, I've managed to get the code working, however it only imported the second table the world document possessed (it has two, one being a single cell, the other being a 2*8 cell table); would it be possible to extract both tables (say, listing the first table above the second table)?

@Tinbendr
I tried tinkering around a little with the code that I posted up, changing for instance the count (1) in:
For TableNo = 1 To wdDoc.tables.Count
to '0', although VBA claimed that no such table existed.
I also tried modifying "Teams" in the following line:
Sheets("Teams").Cells(jRow, iCol) = WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text)
to say 'Sheet2' (considering that was the only sheet that I had opened at the time), and it managed to import the contents of the first table (the single-celled one), however nothing of the second.

snb
09-15-2012, 06:01 AM
Do not talk about 'first' table or 'second' table.
The index has only to do with succession/priority.


Sub snb()
With GetObject("G:\OF\__tabel kopie in Excel.docm")
for each tb in .tables
tb.Range.Copy
ThisWorkbook.Sheets(1).Paste ThisWorkbook.Sheets(1).Cells(rows.count,1).end(xlup).offset(2)
next
.Close 0
End With
End Sub