Writing Excel data to Word content controls without error messages - vba

Question

This question is about using content controls to move data values from Excel to Word in VBA. Please note I have enabled the "Microsoft Word 16.0 Object Library" under references in the MSExcel VBA environment.
My project needs to send Excel data to specific places in a Word document.
PROBLEM: It seems I am not using the contentcontrols properly and keep getting runtime errors I'm not finding much information about. Either RTE-438
Object doesen't support this method
or RTE-424
Object Required
Description of what the code does: There are two baseline workbooks with multiple worksheets. Another analysis workbook uses each of these is programmed with VLOOKUP(INDIRECT...),) to generate tables for reports put into a word document. A Variant is used to change the tabs being sourced in the baseline workbook. The analysis is basically CATS-DOGS=PETS. on each cycle through, tables that are not informational (no difference between two baseline workbooks) are skipped and the next tab is analyzed. If a table is informative, then a PDF is produced. The report (a Word document) is updated. Table is added to the report. Upon completion, the next tab or evaluation table is considered.
Sub CommandButton1_Click()
Dim Tabs(0 To 18) As Variant
Tabs(0) = "01"
Tabs(1) = "02"
Tabs(2) = "03"
Tabs(3) = "03"
Tabs(4) = "04"
Tabs(5) = "05"
Tabs(6) = "06"
Tabs(7) = "07"
Tabs(8) = "08"
Tabs(9) = "09"
Tabs(10) = "10"
Tabs(11) = "11"
Tabs(12) = "12"
Tabs(13) = "13"
Tabs(14) = "14"
Tabs(15) = "15"
Tabs(16) = "16"
Tabs(17) = "17"
Tabs(18) = "18"
Dim xlApp As Object
On Error Resume Next
Set xlApp = GetObject("excel.applicaiton")
If Err.Number = 429 Then
Err.Clear
Set xlApp = CreateObject("excel.applicaiton")
End If
On Error GoTo 0
Dim controlThis As String ' the controlThis variable is to the address of the particular data unit that should be passed to a word.documents.contentcontrols to update the text in the word document based on the change in the actual data.
Dim NetworkLocation As String
NetworkLocation = "\\myServer\myFolder\mySubfolder\"
Dim CATS As String
CATS = "kittens.xlsx"
Excel.Application.Workbooks.Open FileName:=(NetworkLocation & "Other Subforder\ThisWway\" & CATS)
Dim DOGS As String
DOGS = "puppies.xlsx"
Excel.Application.Workbooks.Open FileName:=(NetworkLocation & "differentSubfolder\ThatWay\" & DOGS)
'Populates the array with analysis tables
Dim Temples As Object
Dim Template(3 To 9) As Variant
Template(3) = "\3\EVAL Table 3.xlsx"
Template(4) = "\4\EVAL Table 4.xlsx"
Template(5) = "\5\EVAL Table 5.xlsx"
Template(6) = "\6\EVAL Table 6.xlsx"
Template(7) = "\7\EVAL Table 7.xlsx"
Template(8) = "\8\EVAL Table 8.xlsx"
Template(9) = "\9\EVAL Table 9.xlsx"
Dim strXLname As String
Dim opener As Variant
For Each opener In Template
strXLname = NetworkLocation & "Other Subfolder\EVAL Tables\WonderPets" & opener
Excel.Application.Workbooks.Open FileName:=strXLname
Dim currentDiffernce As Long
currentDifference = ActiveSheet.Cells(5, 6).Value
'This code cycles through the different EVAL Table templates
ActiveSheet.Cells(1, 1).Value = CATS
ActiveSheet.Cells(2, 1).Value = DOGS
Dim k As Variant
For Each k In Tabs
controlThis = k & "-" & eval 'passes a string to the wdApp.contentcontrol
ActiveSheet.Rows.Hidden = False
ActiveSheet.Cells(1, 4).Value = k 'initialize k
ActiveSheet.Calculate
DoEvents
currentDifference = ActiveSheet.Cells(5, 6).Value 'stop blank tables from being produced using the total delta in the preprogrammed spreadsheet
If currentDifference = 0 Then 'since the total difference in the current analysis is 0 this bit of code skips to the next WonderPet
Else
controlThis = k & "-" & opener '(Was eval as variant used with thisTable array)passes a string to the wdApp.contentcontrol
Call PDFcrate 'Print the Table to a PDF file. Worked well and was made a subroutine.
Dim objWord As Object
Dim ws As Worksheet
'Dim cc As Word.Application.ContentControls
Set ws = ActiveWorkbook.Sheets("Sheet1")
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Documents.Open FileName:="myFilePath\Myfile.docx", noencodingdialog:=True ' change as needed
With objWord.ActiveDocument
.ContentControls(controlThis & " cats").Range.Text = eval.ActiveSheet.Cells(5, 4) 'These are the updates to the report for each content control with the title. Substituting SelectContentControlsByTitle() gives RTE-424 'Object Required'
.ContentControls(controlThis & " dogs").Range.Text = eval.ActiveSheet.Cells(5, 5)
.ContentControls(controlThis & " pets").Range.Text = eval.ActiveSheet.Cells(5, 6)
.ContentControls(controlThis & " Table).range. = 'Need to add the PDF to the report, perhaps using an RichTextConentConrols...additional suggestions welcomed (haven't researched it yet).
End With
Set objWord = Nothing
Word.Application.Documents.Close SaveChanges:=True 'Saves and Closes the document
Word.Application.Quit 'quits MS Word
End If
Next 'repeats for each tab with name "k" in the workbooks
Excel.Application.Workbooks(strXLname).Close
Next 'repeat for each evalTable
Excel.Application.Workbooks(CATS).Close
Excel.Application.Workbooks(DOGS).Close
End Sub

Answer 1

Word's content controls can't be picked up using a string as the index value the way other things can. The following line from the code sample in the question can't work:
.ContentControls(controlThis & " cats").Range.Text = eval.ActiveSheet.Cells(5, 4)
The only valid index value for a ContentControl is ID, which is a long number (GUID) assigned by the Word application when a ContentControl is generated.
The reason for this is that more than one content control can have the same Title (name) and/or Tag. Since this information is not unique it can't be used to pick up a single content control.
Instead, code needs to use either Document.SelectContentControlsByTitle or Document.SelectContentControlsByTag. These return an collection of content controls that meet the specified criterium. For example:
Dim cc as Word.ContentControls ' As Object if late-binding is used
With objWord.ActiveDocument
Set cc = .SelectContentControlsByTitle(controlThis & " cats")
'Now loop all the content controls in the collection to work with individual ones
End With
If it's certain there's only one content control with the Title, or only the first one is wanted, then it's possible to do this:
Dim cc as Word.ContentControl ' As Object if late-binding is used
With objWord.ActiveDocument
Set cc = .SelectContentControlsByTitle(controlThis & " cats").Item(1)
cc.Range.Text = eval.ActiveSheet.Cells(5, 4)
End With
Tip 1: Using ActiveDocument is not considered good practice for Word. As with ActiveCell (or anything else) in Excel, it's not certain that the "active" thing is the one that should be manipulated. More reliable is to use an object, which in this case can be assigned directly to the document being opened. Based on the code in the question:
Dim wdDoc as Object 'Word.Document
Set wdDoc = objWord.Documents.Open(FileName:="myFilePath\Myfile.docx", noencodingdialog:=True)
With wdDoc 'instead of objWord.ActiveDocument
Tip 2: Since the code in the question targets multiple content controls, rather than declaring multiple content control objects it might be more efficient to put the titles and values in an array and loop that.

Answer 2

This fixed it... looping through may have been the thing that got me unstuck.
The use of the plural ContentControls or singular ContentControl didn't seem to matter. My next trick is to get the tables into the word document... any thoughts?
Set wdDoc = Word.Application.Documents(wdDocReport)
Dim evalData(0 To 2) As Variant
evalData(0) = " CATS"
evalData(1) = " DOGS"
evalData(2) = " PETS"
Dim j As Variant
Dim i As Integer
i = 4
For Each j In evalData
Dim cc As Word.ContentControls
With Word.Application.Documents(wdDocReport)
.SelectContentControlsByTitle(controlThis & j).Item (1).Range.Text = ActiveWorkbook.ActiveSheet.Cells(5, i).Value
i = i + 1
End With
Next
Word.Application.Documents.Close SaveChanges:= True
Word.Application.Quit
Only one worksheet ever takes focus so the ActiveWorkbook and ActiveWorksheet didn't hurt me here