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