VBA: Extract specific word table to excel

[Xlacs]

Hi Good People,

I'm having a hard timing fixing the below code.
My problem is I wanted to extract a multiple survey answer in ms word table..
The below code extract only a single word file. I wanted to extract all the docx with file name Form* (e.g. Form 1,Form2, FOrm 3, etc.)

The word table looks like the below. I only wanted to extract the "x" starting from row 2 column 2..

Hoping someon can actually help me on this.. Thank you in Advance!

Questions	Agree	Disagree	Neutral	Strongly Disagree
What is ----		x
What is -----	x

Sub extractData()

Dim wd As New Word.Application
Dim doc As Word.Document
Dim sh As Worksheet

wd.Visible = True

Set doc = wd.Documents.Open(ActiveWorkbook.Path & "\Form.docx")
Set tbls = doc.Tables
Set sh = ActiveSheet

lr = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1

For i = 1 To 6
    sh.Cells(lr, i).Value = Application.WorksheetFunction.Clean(tbls(1).Rows(i).Cells(2).Range.Text)
Next

doc.Close
wd.Quit
Set doc = Nothing
Set sh = Nothing
Set wd = Nothing


End Sub

 

[NdNoviceHlp]

Here's some untested , not well commented code, that looks like it should work for 1 doc with multiple tables. HTH. Dave

With Wd.Activedocument
tableTot = .tables.Count
For tableStart = 1 To tableTot
With .tables(tableStart)
For iRow = 2 To .Rows.Count ' table rows
ColCnt = 1 'sht column
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1 'sht row
For iCol = 1 To .Columns.Count 'table columns
If .cell(iRow, iCol).Range.Text = "X" Then
sh.Cells(lr, ColCnt).Value = Application.WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
ColCnt = ColCnt + 1
End If
Next iCol
Next iRow
End With
Next tableStart
End With

 

[Xlacs]

Here's some untested , not well commented code, that looks like it should work for 1 doc with multiple tables. HTH. Dave

With Wd.Activedocument
tableTot = .tables.Count
For tableStart = 1 To tableTot
With .tables(tableStart)
For iRow = 2 To .Rows.Count ' table rows
ColCnt = 1 'sht column
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1 'sht row
For iCol = 1 To .Columns.Count 'table columns
If .cell(iRow, iCol).Range.Text = "X" Then
sh.Cells(lr, ColCnt).Value = Application.WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
ColCnt = ColCnt + 1
End If
Next iCol
Next iRow
End With
Next tableStart
End With

Wooh! Thanks. However, I'm having an error with " the command is not available because no document is open"

Sub Open_Multiple_Word_Files(sPattern As String)
Dim shApp As Object
Dim shFolder As Object
Dim File, Files
Dim currentPath As String


'get folder
    Set shApp = CreateObject("shell.application")
    folder2search = "C:\Users\ChrisLacs\Desktop\extrac\"
    Set shFolder = shApp.Namespace(folder2search)
'get files
    Set Files = shFolder.Items()
'check if file names match the pattern
    For Each File In Files
        If File.Name Like sPattern Then
        
        
           

Dim wd As New Word.Application
Dim doc As Word.Document
Dim sh As Worksheet

wd.Visible = True

With wd.ActiveDocument
tableTot = .Tables.Count
For tableStart = 1 To tableTot
With .Tables(tableStart)
For iRow = 2 To .Rows.Count ' table rows
ColCnt = 1 'sht column
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1 'sht row
For iCol = 1 To .Columns.Count 'table columns
If .Cell(iRow, iCol).Range.Text = "X" Then
sh.Cells(lr, ColCnt).Value = Application.WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text)
ColCnt = ColCnt + 1
End If
Next iCol
Next iRow
End With
Next tableStart
End With



            
            Debug.Print File.Name & " - " & (File.Name Like sPattern)
        
        End If
    Next File
End Sub

Sub Search_it()
    Open_Multiple_Word_Files "Form*"
End Sub

 

[NdNoviceHlp]

You haven't opened any documents. You need to ...

Wd.Documents.Open Filename:=docPath

Where "docpath" is the full path to the doc U want to extract info from. Also, using "File" as a variable is not good as it has a specific XL meaning. Maybe this thread will help...

VBA - Import multiple tables from Word

Hello Experts, I need your help, to modify below VBA code, which I've found exploring the web. I have several word documents in a folder, containing different number of tables. Below I've pasted a picture of the word document and the result in Excel. As you may see in the result, the top of...

www.mrexcel.com

Dave

 

[Xlacs]

Wooh! Thanks. However, I'm having an error with " the command is not available because no document is open"

Sub Open_Multiple_Word_Files(sPattern As String)
Dim shApp As Object
Dim shFolder As Object
Dim File, Files
Dim currentPath As String


'get folder
    Set shApp = CreateObject("shell.application")
    folder2search = "C:\Users\ChrisLacs\Desktop\extrac\"
    Set shFolder = shApp.Namespace(folder2search)
'get files
    Set Files = shFolder.Items()
'check if file names match the pattern
    For Each File In Files
        If File.Name Like sPattern Then
       
       
          

Dim wd As New Word.Application
Dim doc As Word.Document
Dim sh As Worksheet

wd.Visible = True

With wd.ActiveDocument
tableTot = .Tables.Count
For tableStart = 1 To tableTot
With .Tables(tableStart)
For iRow = 2 To .Rows.Count ' table rows
ColCnt = 1 'sht column
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1 'sht row
For iCol = 1 To .Columns.Count 'table columns
If .Cell(iRow, iCol).Range.Text = "X" Then
sh.Cells(lr, ColCnt).Value = Application.WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text)
ColCnt = ColCnt + 1
End If
Next iCol
Next iRow
End With
Next tableStart
End With



           
            Debug.Print File.Name & " - " & (File.Name Like sPattern)
       
        End If
    Next File
End Sub

Sub Search_it()
    Open_Multiple_Word_Files "Form*"
End Sub

It opens only a single word. Other docx with file name Form* does not follow..

 

[NdNoviceHlp]

Not sure what you mean but you still need to open the doc using the full path before you can access the table data. Dave

 

[RoryA]

A reminder:

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at:

VBA: extract specific table from word to excel - OzGrid Free Excel/VBA Help Forum

I Good People I managed to identify all th word docs. However, I'm having a problem achieving to extract the 2nd column row 2 data of the table. Error: Set Table = doc.Table Object variable block The word table looks like the attached img. I…

forum.ozgrid.com

There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.