Populate Excel File from Word Document Tables - VBA

Question

I'm fairly new to VBA and trying to populate a preexisting excel document based on Word Documents.

The Word Documents will have three tables, and certain cells will become the Excel columns. The idea is, every day new product information sheets come in and the Excel sheet will need to be appended. I've started by looking over this previously asked question. Do I create a macro-enabled excel sheet and run it from within Excel? Could I get the macro to look inside a directory for the word documents, and perform an iterative macro?

Answer 1

That's the simplest solution. In Excel set a reference to Word in the VB Editor using Tools, References - you can then write code to manipulate Word from within Excel. You can use the keyword DIR to look for files in a folder, then declare a Word object, open the word document, iterate over the tables in the document and copy the values across to the right cells in Excel. Just watch for the ^p character that Word sticks in the cells - I tend to out the word cell's contents into a string variable and then take Left(s,len(s)-1) into excel to drop the last char.

Answer 2

How about this?

Sub ImportFromWord()

Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document

Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True

Set wrdDoc = wrdApp.Documents.Open(ThisWorkbook.Path & "\My document.doc")
'Use below line if document is already open.
'Set wrdDoc = Documents("My document.doc")

With wrdDoc

    N_Of_tbles = .Tables.Count

    If N_Of_tbles = 0 Then
        MsgBox "There are no tables in word document"
    End If

    Set wrdTbl = .Tables(1)

    ColCount = wrdTbl.Columns.Count
    RowCount = wrdTbl.Rows.Count


    ' Loop through each row of the table
    For i = 1 To RowCount
        'Loop through each column of that row
        For j = 1 To ColCount
            'This gives you the cell contents
            Worksheets("sheet1").Cells(i, j) = wrdTbl.Cell(i, j).Range.Text
        Next j
    Next i
End With

Set wrdDoc = Nothing
Set wrdApp = Nothing

MsgBox "completed"

End Sub