Excel Data Matching Word Tables & Looping

**Ichor** · 06-05-2013, 07:59 AM

Hi, I am fairly new to VBA so I have been searching thoughthis forum for examples. There seem to be plenty of similar macros butnothing suitable.
What I am trying to do is to match data at the top of theworkbook in a range of tables in multiple word files. Then pull the information in the cell to theright into the workbook in the appropriate cell.
I am using 2010 edition of both excel and word, I have attached a sample file with tables that I am trying to pull information from. Any from "Product Name", "Reference Code", "Stones" and "Contains Gluten?"
The following code worked to pull information from contentcontrolled sections of a word file (from a table). I have been unable to workthis for non content controlled though

[VBA]Sub GetFormData()
'Note: this coderequires a reference to the Word object model
Application.ScreenUpdating = False
Dim wdApp As NewWord.Application
Dim wdDoc AsWord.Document
Dim CCtrl AsWord.ContentControl
Dim strFolder AsString, strFile As String
Dim WkSht AsWorksheet, i As Long, j As Long
strFolder =GetFolder
If strFolder ="" Then Exit Sub
Set WkSht =ActiveSheet
i =WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
strFile =Dir(strFolder & "\*.docx", vbNormal)
While strFile<> ""
i = i + 1
Set wdDoc =wdApp.Documents.Open(Filename:=strFolder & "\" & strFile,AddToRecentFiles:=False, Visible:=False)
With wdDoc
j = 0
For EachCCtrl In .ContentControls
j = j + 1
WkSht.Cells(i, j) = CCtrl.Range.Text
Next
End With
wdDoc.CloseSaveChanges:=False
strFile =Dir()
Wend
wdApp.Quit
Set wdDoc =Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating= True
End Sub

Function GetFolder() As String
Dim oFolder AsObject
GetFolder =""
Set oFolder =CreateObject("Shell.Application").BrowseForFolder(0, "Choose afolder", 0)
If (Not oFolder IsNothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder =Nothing
End Function[/VBA]

Any help would be greatly appreciated, thanks
Stephen

**SamT** · 06-05-2013, 09:00 AM

Stephen,

I you would please format you code with some white space to show the logical sections and use the Green VBA button in the Editor windo to place [VBA] tags around your code,. It will make things a lot easier for us.

You can paste your code in the Editor, then Select it and click the VBA tag button, or click the button and paste your code inside the tags.

I have done this for you this time.

[VBA]Option Explicit

Sub GetFormData()
'Note: this code requires a reference to the Word object model
Application.ScreenUpdating = False

Dim wdApp As NewWord.Application
Dim wdDoc As Word.Document
Dim CCtrl As Word.ContentControl
Dim strFolder As String, strFile As String
Dim WkSht As Worksheet, i As Long, j As Long

strFolder = GetFolder
If strFolder = "" Then Exit Sub

Set WkSht = ActiveSheet
i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(strFolder & "\*.docx", vbNormal)

While strFile <> ""
i = i + 1
Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)

With wdDoc
j = 0
For Each CCtrl In .ContentControls
j = j + 1
WkSht.Cells(i, j) = CCtrl.Range.Text
Next
End With

wdDoc.Close SaveChanges:=False
strFile = Dir()
Wend

wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object

GetFolder = ""

Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose afolder", 0)

If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path

Set oFolder = Nothing
End Function
[/VBA]

You will have to use Word's Tables, Cells and Cell objects to accomplish what you need.

If it were my problem, I would write a DocumentOpen Event procedure in Normal.doc that would test newly opened documents for Tables.Count = 5 and Tables(1).Cells(2, 1) for "PRODUCT SPECIFICATION." IF those tests are True then...

I would initiate a new Class object in Normal.doc that had code to retrieve the required values from the just opened Document and store them in Class Properties that Excel could always access directly from Normal.doc.

This would have the advantage that all code to get the Values would be in Word VBA, making the code that much easier to develop, troubleshoot, and maintain.

**snb** · 06-05-2013, 02:40 PM

To retrieve that information from a Word document in folder 'G:\OF\' and the name 'test product.doc" and write it into the active Excel worksheet:

[vba]
Sub M_snb()
With GetObject("G:\OF\Test product.doc")
With .Tables(1)
thisworkbook.sheets(1).Resize(, 4) = Array(.Cell(4, 2), .Cell(5, 2), .Cell(9, 2), .Parent.Tables(2).Cell(2, 1))
End With
.Close 0
End With
End Sub

[/vba]

**Ichor** · 06-06-2013, 04:36 AM

Thanks for the comments, I will let you know if I can get it to work

Regards,
Stephen

**Kenneth Hobs** · 06-07-2013, 09:06 AM

**SamT** · 06-07-2013, 09:10 AM

Thanks Ken,

I just saved all that to my reference files.

Thread: Excel Data Matching Word Tables & Looping

Thread Tools

Display

Excel Data Matching Word Tables & Looping

Posting Permissions