Extracting Form Fields from Word to Excel run-time error

Hi All,

I have a folder containing several *.docx. forms generated from a *.dotm userform that uses document properties. I'd like to use an excel macro to log all of the form fields for each *.docx form. Macropod's solution looks great for doing this, but when I run his macro I receive this error: Run-Time Error '-2147467259 (80004005)': Method 'Visible' of object 'commandbar' failed.


Attached is a sample of my *.docx form and the Macropod code that I haven't been able to get to work.

Thanks for whatever help you can provide.

Admin edit: Attachments removed upon OP request.

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

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

---

Worked like a charm. Thank you very much, Leith!