Application.ScreenUpdating = False
'Note: A VBA Reference to the Excel Object Model is required, via Tools|References
Dim xlApp As New Excel.Application, xlWkBk As Excel.Workbook
Dim StrWkBkNm As String, StrWkShtNm As String, LRow As Long, i As Long
StrWkBkNm = "C:\Users\dlafko\Desktop\Job Titles ONly.xls"
StrWkShtNm = "Sheet1"
If Dir(StrWkBkNm) = "" Then
  MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
  Exit Sub
End If
With xlApp
  'Hide our Excel session
  .Visible = False
  ' Open the workbook
  Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm, ReadOnly:=True, AddToMRU:=False)
  ' Process the workbook.
  With xlWkBk
      With .Worksheets(StrWkShtNm)
        ' Find the last-used row in column A.
        LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        ' Populate the content control titled 'ID', with Column A for the 'ID' as the
        ' content control Text and the values from columns B-E as the content control
        ' value, using a "|" separator
        ActiveDocument.SelectContentControlsByTitle("ID")(1).DropdownListEntries.Clear
        For i = 1 To LRow
          ActiveDocument.SelectContentControlsByTitle("ID")(1).DropdownListEntries.Add _
            Text:=Trim(.Range("A" & i))
          'or, for example, to add the contents of column B to the content control's 'value':
          'ActiveDocument.SelectContentControlsByTitle("ID")(1).DropdownListEntries.Add _
            Text:=Trim(.Range("A" & i)), Value:=Trim(.Range("B" & i))
        Next
      End With
    .Close False
  End With
  .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
Application.ScreenUpdating = True
End Sub

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

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