VBA Command button to pull from Word Table

[JaredMcCullough]

I was wondering if it was plausible to have a VBA which takes data from a word table and plugs it in columns in excel. I have a standard word template that has two columns which get populated by a consultant and then sent to me. Looking for a VBA that would extract these columns and put them in my excel database. Is this possible?

 

[VoG]

Try this - start with a blank sheet in Excel

Sub ImportWordTable1()
'Import one table to current sheet
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 (*.doc),*.doc", , _
"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
                On Error Resume Next
                Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
                On Error GoTo 0
            Next iCol
        Next iRow
    End With
End With
Set wdDoc = Nothing
End Sub

 

[JaredMcCullough]

Try this - start with a blank sheet in Excel

Sub ImportWordTable1()
'Import one table to current sheet
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 (*.doc),*.doc", , _
"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
                On Error Resume Next
                Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
                On Error GoTo 0
            Next iCol
        Next iRow
    End With
End With
Set wdDoc = Nothing
End Sub

Thank you for the reply. I was wondering if you could give me a little more insight into the steps I need to use as I have never attempted interacting word/excel before. Do I have excel file open then open the word document then run the macro or what is the order of sequence. I briefly tried the code using a new excel workbook and the word file but got a "procedure" and a "debugger" error

 

[VoG]

The Word document should NOT be open. You need to start with a blank workbook. Press ALT + F11, select Module from the Insert menu then paste the code into the white space on the right. Press ALT + Q.

Press ALT + F8, double click ImportWordTable then follow the prompts.

 

[JaredMcCullough]

The Word document should NOT be open. You need to start with a blank workbook. Press ALT + F11, select Module from the Insert menu then paste the code into the white space on the right. Press ALT + Q.

Press ALT + F8, double click ImportWordTable then follow the prompts.

Thank you again for the help............I was able run the macro but have a few questions. The first being that I was not able to import all the word files in my folders. Only certain word files were able to be chosen. I am assuming this is due to formatting and the code but do not no where the issue would lie.

My second question is how easily can this coding be taylored to importing to specific positions within an already active workbook?

 

[JaredMcCullough]

The Word document should NOT be open. You need to start with a blank workbook. Press ALT + F11, select Module from the Insert menu then paste the code into the white space on the right. Press ALT + Q.

Press ALT + F8, double click ImportWordTable then follow the prompts.

Mr. VOG,

I was wondering if you had read my previous post and could provide any comments on the questions I had presented.

 

[VoG]

Sorry, I'm out of ideas. I had the script that I posted and several variants but not any that meets your exact needs. We normally discourage posters from posting the same question multiple times but in this case I suggest that you re-post your question here General Excel Discussion & Other Questions and hope that a Word expert can help you.

 

[JaredMcCullough]

Sorry, I'm out of ideas. I had the script that I posted and several variants but not any that meets your exact needs. We normally discourage posters from posting the same question multiple times but in this case I suggest that you re-post your question here General Excel Discussion & Other Questions and hope that a Word expert can help you.

Vog sorry to bother you again. I was wondering if you had any clue why the code you provided does not display all word files. The set of word files I am looking for do not appear in the browse search when I run the macro but are word based files?

 

[Andy959]

Try adding a * after .doc

change:

 wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _

to:

 wdFileName = Application.GetOpenFilename("Word files (*.doc*),*.doc*", , _

If you have older word documents, they'll show up as a .Doc file, newer ones show up as .docx files. You may have both.

 

[JaredMcCullough]

Try adding a * after .doc

change:

 wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _

to:

 wdFileName = Application.GetOpenFilename("Word files (*.doc*),*.doc*", , _

If you have older word documents, they'll show up as a .Doc file, newer ones show up as .docx files. You may have both.

Thanks Andy your suggestion worked perfectly......I was wondering if you had any ideas of how this code could be adjusted to import the table to a specific point within the excel spreadsheet?