Sub list1()
Application.ScreenUpdating = False
Dim strFolder$, strFile$, strDocNm$
strDocNm = ActiveDocument.FullName
strFile = Dir(ActiveDocument.Path & "\list1\*.doc", vbNormal)
Dim oThisdoc As Word.Document
Dim oCC As ContentControl
Dim oCCs As ContentControls

Set oThisdoc = ActiveDocument
Set oCCs = oThisdoc.SelectContentControlsByTag("List1")

    For Each oCC In oCCs
    If oCCs.Count > 0 Then
With oCC
  .DropdownListEntries.Clear
  .Type = wdContentControlText
  .Range.Text = ""
  .Type = wdContentControlDropdownList
  While strFile <> ""
    If strFolder & "\" & strFile <> strDocNm Then
      .DropdownListEntries.Add strFile
    End If
    strFile = Dir()
  Wend
End With
Application.ScreenUpdating = True
End If
Next
End Sub

Sub list2()
Application.ScreenUpdating = False
Dim strFolder$, strFile$, strDocNm$
strDocNm = ActiveDocument.FullName
strFile = Dir(ActiveDocument.Path & "\list2\*.doc", vbNormal)
Dim oThisdoc As Word.Document
Dim oCC As ContentControl
Dim oCCs As ContentControls

Set oThisdoc = ActiveDocument
Set oCCs = oThisdoc.SelectContentControlsByTag("List2")

    For Each oCC In oCCs
    If oCCs.Count > 0 Then
With oCC
  .DropdownListEntries.Clear
  .Type = wdContentControlText
  .Range.Text = ""
  .Type = wdContentControlDropdownList
  While strFile <> ""
    If strFolder & "\" & strFile <> strDocNm Then
      .DropdownListEntries.Add strFile
    End If
    strFile = Dir()
  Wend
End With
Application.ScreenUpdating = True
End If
Next
End Sub

Sub list_to_text()
Dim oThisdoc As Word.Document
Dim oCC As ContentControl
Dim oCCs As ContentControls
Dim sText As String

Set oThisdoc = ActiveDocument
Set oCCs = oThisdoc.SelectContentControlsByTag("List1")



Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
    For Each oCC In oCCs
    If oCCs.Count > 0 Then
    oCC.Range.Select
    oCC.Delete False
    sText = Application.Selection.Text
    End If
Next

                ChangeFileOpenDirectory ActiveDocument.Path & "\List1\"
            Selection.InsertFile FileName:=sText, Range:="", ConfirmConversions:= _
        False, Link:=False, Attachment:=False
            Selection.TypeBackspace
            Selection.MoveRight Unit:=wdCharacter, Count:=1
  
  
End Sub