Extracting Form Fields from Word to Excel run-time error

[matt stiles]

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.

[Leith Ross]

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

[matt stiles]

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