Sub Button1_Click()
 
    Dim oFSO As New FileSystemObject
    Dim oFil As File
    Dim oFold As Folder
 
    Set oFold = oFSO.GetFolder("C:\Temp\")
 
    For Each oFil In oFold.Files
        If Right(oFil.Name, 4) = "docx" Then
            Extract (oFil.Name)
        End If
    Next oFil
 
    Set oFSO = Nothing
 
End Sub
 
Public Function Extract(oFN As String)
    On Error Resume Next
    Dim wApp As New Word.Application
    Dim oDoc As Word.Document
    Dim rs As DAO.Recordset
    Dim sql As String
    Dim i As Integer, j As Integer
    Dim resp
 
    Set oDoc = wApp.Documents.Open(FileName:="D:\Temp\" & oFN)
 
    oDoc.Unprotect
 
    i = oDoc.ContentControls.Count
    ''resp = MsgBox(i, , "NumberOfFormfields")
    ''resp = MsgBox(oDoc.ContentControls(2).Range)
    Debug.Print i
    Dim sheet As Excel.Worksheet
 
    Set sheet = Workbooks("Collection.xlsm").Worksheets("Collection")
        For j = 0 To i
            sheet.Cells(1, j).Value = oDoc.ContentControls(j).Range
        Next j
        'sheet.Columns(j + 1) = oFN
        sheet.Columns.Update
    oDoc.Close SaveChanges:=False
    Set sheet = Nothing
    Set oDoc = Nothing
    wApp.Quit
 
End Function