Microsoft Office Forums - View Single Post - [Solved] Take an Excel List and Add to Word Combo Box

gmayor · 04-10-2019, 09:18 PM

If this is a content control dropdown then the following code will fill such a content control with the items from a column in an Excel Worksheet.

Code:

Option Explicit

Public Function xlFillCCList(strBoxTitle As String, _
                             iColumn As Long, _
                             strWorkbook As String, _
                             strRange As String, _
                             RangeIsWorksheet As Boolean, _
                             RangeIncludesHeaderRow As Boolean)

'Graham Mayor - http://www.gmayor.com - Last updated - 11 April 2019
'strBoxTitle is the name of the list or combo box content control to be filled
'iColumn is the column in the sheet (or the range) to be displayed in the list/combo box
'Columns are numbered starting from 0 i.e. Column A would be iColumn = 0
'strWorkbook is the full path of the workbook containing the data
'strRange is the name of the worksheet or named range containing the data
'RangeIsWorksheet - set to True if the range 'strRange' is a worksheet
' or False if it is a named range
'RangeIncludesHeaderRow - Set to True is the Worksheet or named range contains a header row


Dim RS As Object
Dim CN As Object
Dim oCC As ContentControl
Dim NumRecs As Long, lngRec As Long
Dim strWidth As String
Dim arr() As Variant

    If RangeIsWorksheet = True Then
        strRange = strRange & "$]"
    Else
        strRange = strRange & "]"
    End If

    Set CN = CreateObject("ADODB.Connection")


    If RangeIncludesHeaderRow Then
        CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                                  "Data Source=" & strWorkbook & ";" & _
                                  "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
    Else
        CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                                  "Data Source=" & strWorkbook & ";" & _
                                  "Extended Properties=""Excel 12.0 Xml;HDR=NO"";"
    End If

    Set RS = CreateObject("ADODB.Recordset")
    RS.CursorLocation = 3

    RS.Open "SELECT * FROM [" & strRange, CN, 2, 1    'read the data from the worksheet

    With RS
        .MoveLast
        NumRecs = .RecordCount
        .MoveFirst
    End With

    arr = RS.getrows(NumRecs)

    For Each oCC In ActiveDocument.ContentControls
        If oCC.TITLE = strBoxTitle Then
            With oCC
                .DropdownListEntries.Clear
                For lngRec = 0 To UBound(arr, 2)
                    .DropdownListEntries.Add arr(iColumn, lngRec)
                Next lngRec
            End With
            Exit For
        End If
    Next oCC
lbl_Exit:
    If RS.State = 1 Then RS.Close
    Set RS = Nothing
    If CN.State = 1 Then CN.Close
    Set CN = Nothing
    Set oCC = Nothing
    Exit Function
End Function

The function is called from a macro that provides the variable data e.g.

Code:

Sub Macro1()
xlFillCCList "ContentControl Title", 0, "C:\Path\Datasheet.xlsx", "Worksheet Name", True, True
End Sub

If the dropdown is a userform combobox then see the relevant section at https://www.gmayor.com/Userform_ComboBox.html for code on which the above is loosely based.