Option Explicit
Private strWorkbook As String
Private Const strSheet As String = "general"      'The name of the worksheet
Private oCC As ContentControl
Private Arr() As Variant
Private lRow As Long

Sub AutoOpen()
    FillDropdown
End Sub

Private Sub FillDropdown()
    strWorkbook = ThisDocument.Path & "\test2.xlsx"
    Arr = xlFillArray(strWorkbook, strSheet)
    Set oCC = ActiveDocument.SelectContentControlsByTitle("question type").Item(1)
    With oCC
        .LockContentControl = False
        .Type = wdContentControlComboBox
        .Range.Text = ""
        .DropdownListEntries.Clear
        .SetPlaceholderText Text:="Choose an item"
        For lRow = 0 To UBound(Arr, 2)
            .DropdownListEntries.Add Arr(0, lRow)
        Next lRow
        .LockContentControl = True
    End With
    Set oCC = Nothing
End Sub

Private Function xlFillArray(strWorkbook As String, _
                             strRange As String) As Variant
'Graham Mayor - https://www.gmayor.com - Last updated - 24 Sep 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;IMEX=1"""

    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