Macro to import table from word file to successive rows or columns in excel

[tryingtolovevba]

Hi folks, as my name suggests I am fairly new to VBA and the world of macros but am already enjoying it

I wanted to develop a macro which will import a table or a part of a table from word files (user to be prompted for the location of the word file) in to a single excel worksheet on to successive columns in a single worksheet.

I have tried recording the action and tinkering around with it (as well using some stuff I found in the forum here) and while I am able to affect the open, copy & paste, I don't know to get the macro to use the next empty column on every instance of the macro button being pressed.

Any help would be greatly appreciated.

Sub ImportWordTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _
"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
TableNo = wdDoc.tables.Count
If TableNo = 0 Then
MsgBox "This document contains no tables", _
vbExclamation, "Import Word Table"
ElseIf TableNo > 1 Then
TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _
"Enter table number of table to import", "Import Word Table", "1")
End If
With .tables(TableNo)
'copy cell contents from Word table cells to Excel cells
For iRow = 1 To .Rows.Count
For iCol = 1 To .Columns.Count
Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
Next iCol
Next iRow
End With
End With

Set wdDoc = Nothing

End Sub

 

[tlowry]

Congrats on your number 1 post to MrExcel.

I did a bit of "recoding" and came up with the following:

Sub ImportWordTable()
    Dim wdDoc
    Set wdDoc = GetObject("C:\Temp\tabler.doc")
    Dim tbNo
    tbNo = GetTableNo(wdDoc)
    If tbNo = 0 Then Exit Sub
    wdDoc.tables(tbNo).Range.Copy
    ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False
End Sub

Function GetTableNo(wdDoc) As Integer
    Dim tblct, TableNo
    GetTableNo = 0
    tblct = wdDoc.tables.Count
    Select Case wdDoc.tables.Count
        Case 0
            Exit Function
        Case 1
            GetTableNo = 1
        Case Else
            TableNo = InputBox("This Word document contains " & tblct & " tables." & vbCrLf & _
                "Enter table number of table to import", "Import Word Table", "1")
            [B][COLOR=#008000]If TableNo = False Then Exit Function
            If Not IsNumeric(TableNo) Then Exit Function
            TableNo = CInt(TableNo)
            If TableNo > tblct Then Exit Function[/COLOR][/B]
            GetTableNo = TableNo
    End Select
End Function

Note: I did some basic error checking on the table number input. It would be better to not let the user input a number, but "force" a correct selection, but that's another story...