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

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:

Code:

---

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.

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

Code:

---

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.

Code:

---

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

---

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.