Import into Excel from Word file with multiple repeated Content Control tables

[K42]

Hi all,

I'm new to VBA and I have spent a few days trying to trial and error something together from various threads and code snippets. I don't fully understand what I need to change in order to get the code to do what I need it to. I need to be able to pull data from a word file which contains multiple repeated content control tables (see testfile.docx), which I would like to pull into Excel in the following format:



Value A
Value B
Value C
Value D


A1
B1
C1
D1


A2
B2
C2
D2


A3
B3
C3
D3


A4
B4
C4
D4


A5
B5
C5
D5



The above is dummy data but the format is the same. The number of tables in the actual Word file is not fixed, but I'm looking at approximately 600 tables each time I need to run this process. They'll all have the same number of values (9 - we're using 4 just for the sake of this example) and some of those values might be blank, in which case I just want a blank Excel cell. There's nothing special about the Excel document, it's just a new worksheet each time I run this process.

The problem I'm having is that I can't get the VBA to iterate onto the next set of tables. In fact, it's only generating one row of data from the 5 tables in testfile.docx, and the values are not even from the same table. In an earlier attempt I did manage to get multiple rows, but it was just a repeat of the same table over and over again. I suspect that I might be going about this entirely the wrong way and I've made a complete mess. I would be grateful for a steer.

I'm using Excel for Office 365 at home, but I need this to work in Excel 2016 at work. I would really appreciate it if someone could please talk me through what I'm not understanding, or point me to a resource I can use to try and solve this. I've also tried using the exact code from this thread (vbaexpress.com/forum/show...l=1#post257696), but it doesn't work with my content controls and I'm not sure why. Code follows:


Sub getWordFormData()
Dim wdApp As Object, myDoc As Object
Dim myFolder As String, strFile As String
Dim i As Long, j As Long

myFolder = "D:\"

If Len(Dir(myFolder)) = 0 Then
MsgBox myFolder & vbCrLf & "Not Found", vbInformation, "Cancelled - getWordFormData"
Exit Sub
End If

Application.ScreenUpdating = False
Set wdApp = CreateObject("Word.Application")

With ActiveSheet
.Cells.Clear
With .Range("A1:D1")
.Value = Array("ValueA", "ValueB", "ValueC", "ValueD")
.Font.Bold = True
End With

strFile = Dir(myFolder & "testfile.docx", vbNormal)
i = 1

While strFile <> ""
i = i + 1

Set myDoc = wdApp.Documents.Open(Filename:=myFolder & "\" & strFile, ReadOnly:=True, AddToRecentFiles:=False, Visible:=False)

.Cells(i, 1).Value = myDoc.SelectContentControlsByTag("ValueA").Item(1).Range.Text
.Cells(i, 2).Value = myDoc.SelectContentControlsByTag("ValueB").Item(1).Range.Text
.Cells(i, 3).Value = myDoc.SelectContentControlsByTag("ValueC").Item(1).Range.Text
.Cells(i, 4).Value = myDoc.SelectContentControlsByTag("ValueD").Item(1).Range.Text

myDoc.Close SaveChanges:=False
strFile = Dir()
Wend
wdApp.Quit

Application.ScreenUpdating = True
End With

End Sub

Thank you very much. Please let me know if I can provide any more information.

[gmayor]

What you are not understanding is that there is only one of each content controls in the document i.e. Item(1), no matter how many tables there are, and they are not where you might suspect. This can easily be demonstrated with your test document and the following Word macro

Sub Macro1()
Dim oCC As ContentControl
Set oCC = ActiveDocument.SelectContentControlsByTitle("ValueA").Item(1)
oCC.Range.Font.ColorIndex = wdRed
Set oCC = ActiveDocument.SelectContentControlsByTitle("ValueB").Item(1)
oCC.Range.Font.ColorIndex = wdRed
Set oCC = ActiveDocument.SelectContentControlsByTitle("ValueC").Item(1)
oCC.Range.Font.ColorIndex = wdRed
Set oCC = ActiveDocument.SelectContentControlsByTitle("ValueD").Item(1)
oCC.Range.Font.ColorIndex = wdRed
End Sub

You therefore need a different approach e.g.


Sub getWordFormData()Dim wdApp As Object, myDoc As Object, oCC As Object
Dim myFolder As String, strFile As String
Dim i As Long, j As Long


myFolder = "D:\"


If Len(Dir(myFolder)) = 0 Then
MsgBox myFolder & vbCrLf & "Not Found", vbInformation, "Cancelled - getWordFormData"
Exit Sub
End If


Application.ScreenUpdating = False
Set wdApp = CreateObject("Word.Application")


With ActiveSheet
.Cells.Clear
With .Range("A1:D1")
.value = Array("ValueA", "ValueB", "ValueC", "ValueD")
.Font.Bold = True
End With
strFile = Dir(myFolder & "testfile.docx", vbNormal) 'There will only be one testfile.docx in that folder?
i = 0 'Change to 0
While strFile <> ""
i = i + 1
Set myDoc = wdApp.Documents.Open(FileName:=myFolder & "\" & strFile, ReadOnly:=True, AddToRecentFiles:=False, Visible:=False)
For j = 1 To myDoc.Tables.Count 'Loop throughout the tables
For Each oCC In myDoc.Tables(j).Range.ContentControls 'loop through the content controls in the table
Select Case oCC.Title
Case Is = "ValueA"
.Cells(i + j, 1).value = oCC.Range.Text
Case Is = "ValueB"
.Cells(i + j, 2).value = oCC.Range.Text
Case Is = "ValueC"
.Cells(i + j, 3).value = oCC.Range.Text
Case Is = "ValueD"
.Cells(i + j, 4).value = oCC.Range.Text
End Select
Next oCC
Next j
myDoc.Close SaveChanges:=False
strFile = Dir()
Wend
wdApp.Quit
Application.ScreenUpdating = True
End With
Set myDoc = Nothing
Set oCC = Nothing
Set wdApp = Nothing
End Sub

[K42]

Thank you so, so much Graham. This does exactly what I need. Looks like I was pretty far off-base, so I really appreciate you taking the time to write this out, and that you commented the code.