I have given your the code and process for establishing the ADODB connection and populating an array from an Excel spreadsheet:
Code:
Sub Document_Open()
Dim strWorkbook As String, strColumnData As String
Dim lngIndex As Long, lngRowIndex As Long, lngColIndex As Long
Dim arrData As Variant
Dim oCC As ContentControl
Application.ScreenUpdating = False
strWorkbook = "D:\Data Stores\Fill CC from Excel Data Store.xlsx"
If Dir(strWorkbook) = "" Then
MsgBox "Cannot find the designated workbook: " & strWorkbook, vbExclamation
Exit Sub
End If
Set oCC = ActiveDocument.SelectContentControlsByTitle("Name").Item(1)
arrData = fcnExcelDataToArray(strWorkbook, "Data")
If oCC.DropdownListEntries.Item(1).Value = vbNullString Then
For lngIndex = oCC.DropdownListEntries.Count To 2 Step -1
oCC.DropdownListEntries.Item(lngIndex).Delete
Next lngIndex
Else
oCC.DropdownListEntries.Clear
End If
For lngRowIndex = 0 To UBound(arrData, 2)
'Examples:
'1. Populate the dropdown list text and value property using data from column 1
'oCC.DropdownListEntries.Add arrData(0, lngRowIndex), arrData(0, lngRowIndex)
'2. Populate the dropdown list text property using data from column 1 _
and the value property using data from column 2
'oCC.DropdownListEntries.Add arrData(0, lngRowIndex), arrData(1, lngRowIndex)
'3. Populate the dropdown list text property using data from column 1 _
' and the value property using concanated data from all remaining columns.
strColumnData = vbNullString
For lngColIndex = 1 To UBound(arrData, 1)
strColumnData = strColumnData & "|" & arrData(lngColIndex, lngRowIndex)
Next lngColIndex
strColumnData = Right(strColumnData, Len(strColumnData) - 1)
oCC.DropdownListEntries.Add arrData(0, lngRowIndex), strColumnData
Next
lbl_Exit:
Application.ScreenUpdating = True
Exit Sub
End Sub
Private Function fcnExcelDataToArray(strWorkbook As String, _
Optional strRange As String = "Sheet1", _
Optional bIsSheet As Boolean = True, _
Optional bHeaderRow As Boolean = True) As Variant
Dim oRS As Object, oConn As Object
Dim lngRows As Long
Dim strHeaderYES_NO As String
strHeaderYES_NO = "YES"
If Not bHeaderRow Then strHeaderYES_NO = "NO"
If bIsSheet Then strRange = strRange & "$]" Else strRange = strRange & "]"
Set oConn = CreateObject("ADODB.Connection")
oConn.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWorkbook & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=" & strHeaderYES_NO & """;"
Set oRS = CreateObject("ADODB.Recordset")
oRS.Open "SELECT * FROM [" & strRange, oConn, 2, 1
With oRS
.MoveLast
lngRows = .RecordCount
.MoveFirst
End With
fcnExcelDataToArray = oRS.GetRows(lngRows)
lbl_Exit:
If oRS.State = 1 Then oRS.Close
Set oRS = Nothing
If oConn.State = 1 Then oConn.Close
Set oConn = Nothing
Exit Function
End Function