Hello Matt,
I did not receive the error you did. However, there were some problems with the code. The code here has been run using the Word file you provide and all fields were returned.
Replace the code in your VBA module named Module1 with this code.
Module1 Code
Sub GetFormData()
'Note: this code requires a reference to the Word object model
Dim FmFld As Word.Field
Dim i As Long
Dim j As Long
Dim strFile As String
Dim strFolder As String
Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim WkSht As Worksheet
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
If .SelectedItems.Count = 0 Then Exit Sub
strFolder = .SelectedItems(1)
End With
Set WkSht = ActiveSheet
i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
i = i + 1
If IsFileOpen(strFolder & "\" & strFile) Then
Set wdApp = GetObject(, "Word.Application")
Set wdDoc = wdApp.ActiveDocument
Else
Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
End If
With wdDoc
j = 0
For Each FmFld In .Fields
j = j + 1
If FmFld.Type = wdFieldOCX Then
WkSht.Cells(i, j) = FmFld.OLEFormat.Object.Value
Else
WkSht.Cells(i, j) = FmFld.Result
End If
Next
End With
wdDoc.Close SaveChanges:=False
strFile = Dir()
Wend
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
End Sub
Function IsFileOpen(ByVal FilePath As String) As Boolean
On Error Resume Next
Open FilePath For Input Lock Read As #1
Close #1
Select Case Err.Number
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
End Select
On Error GoTo 0
End Function