Updating Content Controls from Excel

[jarnold231]

Good evening,

I'm trying to get a large set of tagged Content Controls in a .docm word document to update from an excel file.

The Excel File will already be open, but I've been having trouble setting the script to link to the open Excel.

Any help greatly appreciated

    
        Dim cc As ContentControl
        For Each cc In ActiveDocument.SelectContentControlsByTag("#uCONM#")
          cc.Range.Text = oWB.Sheets("TextElements").Range("B9").Value
        Next
        
        For Each cc In ActiveDocument.SelectContentControlsByTag("#lCONM#")
          cc.Range.Text = oWB.Sheets("TextElements").Range("B10").Value
        Next

The Excel is opened by this

Sub OpenWorkbook()


Dim oXL As excel.Application
Dim oWB As excel.Workbook
Dim oSheet As excel.Worksheet
Dim oRng As excel.Range
Dim ExcelWasNotRunning As Boolean
Dim MasterTemplate As String


'specify the workbook to work on
MasterTemplate = "T:\Trendline\6. Templates\1. Data Extraction Templates\Master_Extraction_Template.xlsm"


'If Excel is running, get a handle on it; otherwise start a new instance of Excel
On Error Resume Next
Set oXL = GetObject(, "Excel.Application")


If Err Then
   ExcelWasNotRunning = True
   Set oXL = New excel.Application
End If


'If you want Excel to be visible, you could add the line: oXL.Visible = True here; but your code will run faster if you don't make it visible
oXL.Visible = True


'Open the workbook
Set oWB = oXL.Workbooks.Open(FileName:=MasterTemplate)


End Sub

[macropod]

So what is the problem? As it is, it's not apparent how your first code bloack relates to the second which, as it stands, simply opens then closes the workbook.

[jarnold231]

I'm happy with the open Excel portion of the code (I've just adapted it so that it doesn't close).

I was hoping to create a new Sub to update the ContentControls from the now open excel file.

The bit I've been having trouble with is setting the objects so that they refer to the open excel file.

[macropod]

There was no need to edit the code in your first post. Indeed, doing so makes a nonsense of my previous reply. After opening your workbook, but before closing it, all you need to do is insert a call to whatever sub updates the content control. For example:

'Open the workbook
Set oWB = oXL.Workbooks.Open(FileName:=MasterTemplate)
Call UpdateCCs(oWB)

You might then code sub that updates the content control as:

Sub UpdateCCs(oWB as Excel.Workbook)
Dim cc As ContentControl
For Each cc In ActiveDocument.SelectContentControlsByTag("#uCONM#")
  cc.Range.Text = oWB.Sheets("TextElements").Range("B9").Value
Next        
For Each cc In ActiveDocument.SelectContentControlsByTag("#lCONM#")
  cc.Range.Text = oWB.Sheets("TextElements").Range("B10").Value
Next
End Sub

[gmayor]

An alternative approach would be to read the worksheet into an array and read the array, which is much faster, and does not require the workbook to be opened and closed e.g. as follows. The code assumes a header row at Row 1 and that there are values in column A. You could use instead of the worksheet name a named range (with or without a header row)

Option Explicit

Const strWorkbook As String = "T:\Trendline\6. Templates\1. Data Extraction Templates\Master_Extraction_Template.xlsm"   'The path of the workbook
Const strSheet As String = "TextElements"        'The name of the worksheet

Sub FillCCs()
Dim CC As ContentControl
Dim Arr() As Variant

    Arr = xlFillArray(strWorkbook, strSheet)
    For Each CC In ActiveDocument.SelectContentControlsByTag("#uCONM#")
        CC.Range.Text = Arr(1, 8) 'Numbers start from 0 this column 2 row 9
    Next

    For Each CC In ActiveDocument.SelectContentControlsByTag("#lCONM#")
        CC.Range.Text = Arr(1, 9)
    Next
lbl_Exit:
    Set CC = Nothing
    Exit Sub
End Sub

Private Function xlFillArray(strWorkbook As String, _
                             strRange As String) As Variant
'Graham Mayor - http://www.gmayor.com - 24/09/2016
Dim RS As Object
Dim CN As Object
Dim iRows As Long

strRange = strRange & "$]"    'Use this to work with a named worksheet
    'strRange = strRange & "]" 'Use this to work with a named range
    Set CN = CreateObject("ADODB.Connection")

    'Set HDR=NO for no header row
    CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                              "Data Source=" & strWorkbook & ";" & _
                              "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"

    Set RS = CreateObject("ADODB.Recordset")
    RS.Open "SELECT * FROM [" & strRange, CN, 2, 1

    With RS
        .MoveLast
        iRows = .RecordCount
        .MoveFirst
    End With
    xlFillArray = RS.GetRows(iRows)
    If RS.State = 1 Then RS.Close
    Set RS = Nothing
    If CN.State = 1 Then CN.Close
    Set CN = Nothing
lbl_Exit:
    Exit Function
End Function