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.