Consulting

Results 1 to 3 of 3

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

  1. #1

    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:

    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.
    Attached Files Attached Files

  2. #2
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •