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