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!