Private Sub Document_ContentControlOnEnter(ByVal CCtrl As ContentControl)
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String
With CCtrl
  .DropdownListEntries.Clear
  .Type = wdContentControlText
  .Range.Text = ""
  .Type = wdContentControlDropdownList
   Case .Tag
    Case "List1": strFolder = ActiveDocument.Path & "\list1\"
    Case "List2": strFolder = ActiveDocument.Path & "\list2\"
    Case "List3": strFolder = ActiveDocument.Path & "\list3\"
  End 
  strFile = Dir(strFolder & "*.doc", vbNormal)
  While strFile <> ""
    .DropdownListEntries.Add strFile
    strFile = Dir()
  Wend
End With
Application.ScreenUpdating = True
End Sub