Option Explicit

Private Sub Document_ContentControlOnExit(ByVal oCC As ContentControl, Cancel As Boolean)
Dim arrData() As String
Dim lngIndex As Long
  Select Case oCC.Title
    Case "Name"
      If Not oCC.ShowingPlaceholderText Then
        'Determine which dropdown list entry was selected. Note: The object model has no direct way to do this.
        For lngIndex = 1 To oCC.DropdownListEntries.Count
          If oCC.Range.Text = oCC.DropdownListEntries.Item(lngIndex) Then
            'Get the data from the CC value property.
            arrData = Split(oCC.DropdownListEntries.Item(lngIndex).Value, "|")
            Exit For
          End If
        Next lngIndex
        'Use that date fill in the transposed name and fill the dependent fields.
        With oCC
          .Type = wdContentControlText
          .Range.Text = arrData(0)
          .Type = wdContentControlDropdownList
        End With
        'In the Excel data, "~" is used to define linebreaks in the address column.  Replace with linebreaks.
        ActiveDocument.SelectContentControlsByTitle("Address").Item(1).Range.Text = Replace(arrData(1), "~", Chr(11))
        ActiveDocument.SelectContentControlsByTitle("Phone Number").Item(1).Range.Text = arrData(2)
      Else
        'Reset the dependent CCs.
        ActiveDocument.SelectContentControlsByTitle("Address").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTitle("Phone Number").Item(1).Range.Text = vbNullString
      End If
    Case Else
  End Select
lbl_Exit:
  Exit Sub
End Sub

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