Excel VBA, how to retrieve textbox title/label in word fillable form

[chieh]

Hi All:

I am fairy new to VBA programming.

I have multiple word fillable form, I need to retrive all the value filled in by the user on each form and insert the value into Excel sheet row by row, each row represents 1 file.

I got the program working using Excel VBA (I paste the full program code at the end), however I try many ways to get the title or label that's on top of each textbox field.

i.e.
First Name [Chieh ], Last name [Zh ], Address [123 confused street ], ... .... ...
I can get the textbox type, name and result using following command

'Retrieve Full Filename, field type, field name and fieldvalue
strfieldtype = oDoc.FormFields(i).Type
strFieldName = oDoc.FormFields(i).Name
strFieldValue = oDoc.FormFields(i).Result

At the is point, I use the FormField(i).Name as dynamic heading, the program works, but have no success in getting the caption.

My first question is: How do I retrieve the label "First name", "Last Name".... I tried to search through the word object, with no success.... Kindly help.

My second question is. when I ran through my excel vba for the 2nd time, it crashes toward the end. the error messge is " -2147417851: Method 'Item' of object 'FormFields' failed ", any idea on this error? you can copy my code to your local and test it with few word form.

I am working with Excel 2003 and word 2003.

Thanks
Chieh

Below is my VBA code.... I am fairly new to VBA, you're welcome to give me suggestion on making the code work faster and more efficient. Thanks Again.
==========================================================

Sub WordExtract()
'==
'Add Word object reference library.
'Tools->References - Check the Microsoft Word Object Libary box
Dim wbWorkBook As Workbook
Dim wsWorkSheet As Worksheet
Dim oWord As Word.Application
Dim WordWasNotRunning As Boolean
Dim oDoc As Word.Document
Dim varFileName As Variant
Dim intNumberOfField, i As Integer
Dim strPath, strDocFiles, strDisplayText, strFullName, strFieldName, strFieldValue As String
Dim strTempFieldValue As String
Dim wsMessage
Set wsMessage = CreateObject("WScript.Shell")

'For FYI Info....
wsMessage.Popup " This Utility Only Works with *.Doc Files, Not the *.Docx ", 5, "..... Information .....", 4096

Set wbWorkBook = ActiveWorkbook
Set wsWorkSheet = wbWorkBook.Worksheets(1)
Range("A1").Select

'Get existing instance of Word if it's open; otherwise create a new one
On Error Resume Next
Set oWord = GetObject(, "Word.Application")
If Not Err Then
'Close the word instance if open
oWord.Quit
End If

Set oWord = New Word.Application
On Error GoTo Err_Handler

'Prompt user for the directory where all the word document are located.
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 1 Then
strPath = .SelectedItems(1)
End If
End With
If strPath = Empty Then
wsMessage.Popup "No folder Selected", 5, "..... Error .....", 4096
Exit Sub
End If
'Get the last row
xRow = wsWorkSheet.Range("A65536").End(xlUp).Row
'Append new Row.....
xRow = xRow + 2

'Keep track number of word document processed
intFileProcessed = 0

'Retreive list of all the word doc files in the given directory
'For now this only works with *.Doc files only. Not the *.Docx, as we only have word office 2003 installed.
'It can be change easily to accomodiate the new docx format.
strDocFiles = Dir(strPath & "\*.Doc")

' Loop through all the word document in this directory, retrieve the info and insert it into the excel sheet.
Do While strDocFiles <> ""
intFileProcessed = intFileProcessed + 1

'Prompt to select single file
'varFileName = Application.GetOpenFilename("Word Files (*.doc; *.docx), *.doc; *.docx")
'varFileName = Application.GetOpenFilename("Word Files (*.doc; *.docx), *.doc; *.docx", , , 1)
'Prompt to select a directory (More than one word file)
Set oDoc = oWord.Documents.Open(strPath & "\" & strDocFiles, Visible:=False)

With wsWorkSheet
'Get the Total Number of user fillable TextBox field in this Document
intNumberOfField = oDoc.FormFields.Count
'Get the Full Name of the current word document
strFullName = oDoc.FullName

'If this is the first file being processed, retrieve the header too..
'At this point, haven't figure out how to retrieve the textbox title/label, so just retrieve the actual object name
If intFileProcessed = 1 Then
'Loop through all the fillable fields
For i = 1 To intNumberOfField
'Retrieve field object Name and insert/update into Excel cell
strFieldName = oDoc.FormFields(i).Name
'The following commented out line: Trying to get the field caption, didn't work....
'strFieldName = strFieldName & " - " & ActiveDocument.Bookmarks(strFieldName).Range.Text

.Cells(xRow, i + 1) = strFieldName
Next i
'Bold, left justify the first header row
Rows(xRow & ":" & xRow).Select
Selection.Font.Bold = True
'And add date and time stamp to A1 or the current row
.Cells(xRow, 1) = Now()
Rows(xRow & "1").HorizontalAlignment = xlLeft
End If

'Append new Row.....
xRow = xRow + 1

'Update the full name of the word doc in the first column of the current row
.Cells(xRow, 1) = strFullName

'Retrieve the fillable field result for the current document.
For i = 1 To intNumberOfField
'Retrieve Full Filename, field type, field name and fieldvalue
strfieldtype = oDoc.FormFields(i).Type
strFieldName = oDoc.FormFields(i).Name
strFieldValue = oDoc.FormFields(i).Result

'Display processing info in the popup window.....
strDisplayText = "Processing..... " + strFullName + " - Total Field Count: " + Trim(Str(intNumberOfField)) + _
", _Current Field: " + Trim(Str(i)) + " - " + strFieldName + ", Field Value: " + strFieldValue
'wsMessage.Popup strDisplayText, 1, "Processing", 4096

' Type "wdFieldFormCheckBox" = 71, if it's a check box, the value store is either "1" or "0" for true or false
' the following converts "1" to "True" and "0" to "False" for easier understanding by the users.
If strfieldtype = 71 Then
Select Case strFieldValue
Case "0"
strTempFieldValue = "No"
Case "1"
strTempFieldValue = "Yes"
End Select
.Cells(xRow, i + 1) = strTempFieldValue
Else
.Cells(xRow, i + 1) = strFieldValue
End If
'Debug.Print strDisplayText

Next i
End With

oDoc.Close savechanges:=wdDoNotSaveChanges
Set oDoc = Nothing

'Get the next doc
strDocFiles = Dir
Loop

oWord.Quit
'Make sure you release object references.
Set oWord = Nothing
Set oDoc = Nothing

'Select the whole Excel sheet and expand all the columns
wsWorkSheet.Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
ActiveWorkbook.Save

Exit Sub

Err_Handler:
Select Case Err
Case -2147022986, 429
Set oWord = CreateObject("Word.Application")
Resume Next
Case 5121, 5174
MsgBox "You must select a valid Word document. " & "No data imported.", vbOKOnly, "Document Not Found"
Case 5941
MsgBox Err.Description
' 'MsgBox "The document you selected does not " _
' & "contain the required form fields. " _
' & "No data imported.", vbOKOnly, _
' "Fields Not Found"
Case Else
MsgBox Err & ": " & Err.Description
oWord.Quit
End Select
End Sub

[CatDaddy]

I would say what you are looking for is probably formfields(i).Caption
two things though:
1) when you post code wrap it in the VBA tags provided in the box (press the little green button that says VBA)
2) post a sample workbook with your code to make it easier for us to find your problems!

thanks

[chieh]

Hello CatDaddy:

Thank you for your suggestion.

I did try the formfields(i).Caption, there is no such property or method, then I tried the following...

strCaption = oDoc.Bookmarks("Last Name").Range.Text
the value I got is a blank box... i.e. ""
there is 45 formfields in my form, all 45 of them shows this blank box.

Below is my code wrapped in VBA. I cannot include the Excel as it got some confidential info. My code works with any word file that has user input textbox, drop down or other type. you can simply create a new module in excel copy the code and run it. All you need is to get 1 or 2 word form with user input fields.

Thank you.
chieh


Sub WordExtract()
'==
'Add Word object reference library.
'Tools->References - Check the Microsoft Word Object Libary box
Dim wbWorkBook As Workbook
Dim wsWorkSheet As Worksheet
Dim oWord As Word.Application
Dim WordWasNotRunning As Boolean
Dim oDoc As Word.Document
Dim varFileName As Variant
Dim intNumberOfField, i As Integer
Dim strPath, strDocFiles, strDisplayText, strFullName, strFieldName, strFieldValue, strCaption, strTempFieldValue As String
Dim wsMessage
Set wsMessage = CreateObject("WScript.Shell")


Set wbWorkBook = ActiveWorkbook
Set wsWorkSheet = wbWorkBook.Worksheets(1)
Range("A1").Select

'For FYI Info....
wsMessage.Popup " This Utility Only Works with *.Doc Files, Not the *.Docx, Press OK To Continue.... ", 5, _
"..... Information .....", 4096

'Get existing instance of Word if it's open; otherwise create a new one
On Error Resume Next
Set oWord = GetObject(, "Word.Application")
If Not Err Then
'Close the word instance if open
oWord.Quit
End If

Set oWord = New Word.Application
On Error GoTo Err_Handler

'Prompt user for the directory where all the word document are located.
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 1 Then
strPath = .SelectedItems(1)
End If
End With
If strPath = Empty Then
wsMessage.Popup "No folder Selected", 5, "..... Error .....", 4096
Exit Sub
End If
'Get the last row
xRow = wsWorkSheet.Range("A65536").End(xlUp).Row
'Append new Row.....
xRow = xRow + 2

'Keep track number of word document processed
intFileProcessed = 0

'Retreive list of all the word doc files in the given directory
'For now this only works with *.Doc files only. Not the *.Docx, as we only have word office 2003 installed.
'It can be change easily to accomodiate the new docx format.
strDocFiles = Dir(strPath & "\*.Doc")

' Loop through all the word document in this directory, retrieve the info and insert it into the excel sheet.
Do While strDocFiles <> ""
intFileProcessed = intFileProcessed + 1

'Prompt to select single file
'varFileName = Application.GetOpenFilename("Word Files (*.doc; *.docx), *.doc; *.docx")
'varFileName = Application.GetOpenFilename("Word Files (*.doc; *.docx), *.doc; *.docx", , , 1)
'Prompt to select a directory (More than one word file)
Set oDoc = oWord.Documents.Open(strPath & "\" & strDocFiles, Visible:=False)

With wsWorkSheet
'Get the Total Number of user fillable TextBox field in this Document
intNumberOfField = oDoc.FormFields.Count
'Get the Full Name of the current word document
strFullName = oDoc.FullName

'If this is the first file being processed, retrieve the header too..
'At this point, haven't figure out how to retrieve the textbox title/label, so just retrieve the actual object name
If intFileProcessed = 1 Then
'Loop through all the fillable fields
For i = 1 To intNumberOfField
strCaption = ""
'Retrieve field object Name and insert/update into Excel cell
strFieldName = oDoc.FormFields(i).Name
'The following commented out line: Trying to get the field caption, didn't work....
'strCaption = oDoc.Bookmarks(strFieldName).Range.Text
'.Cells(xRow, i + 1) = strFieldName & " - " & strCaption

.Cells(xRow, i + 1) = strFieldName
Next i
'Bold, left justify the first header row
Rows(xRow & ":" & xRow).Select
Selection.Font.Bold = True
'And add date and time stamp to A1 or the current row
.Cells(xRow, 1) = Now()
Rows(xRow & "1").HorizontalAlignment = xlLeft
End If

'Append new Row.....
xRow = xRow + 1

'Update the full name of the word doc in the first column of the current row
.Cells(xRow, 1) = strFullName

'Retrieve the fillable field result for the current document.
For i = 1 To intNumberOfField
'Retrieve Full Filename, field type, field name and fieldvalue
strfieldtype = oDoc.FormFields(i).Type
strFieldName = oDoc.FormFields(i).Name
strFieldValue = oDoc.FormFields(i).Result

'Display processing info in the popup window.....
strDisplayText = "Processing..... " + strFullName + " - Total Field Count: " + Trim(Str(intNumberOfField)) + _
", _Current Field: " + Trim(Str(i)) + " - " + strFieldName + ", Field Value: " + strFieldValue
'wsMessage.Popup strDisplayText, 1, "Processing", 4096

' Type "wdFieldFormCheckBox" = 71, if it's a check box, the value store is either "1" or "0" for true or false
' the following converts "1" to "True" and "0" to "False" for easier understanding by the users.
If strfieldtype = 71 Then
Select Case strFieldValue
Case "0"
strTempFieldValue = "No"
Case "1"
strTempFieldValue = "Yes"
End Select
.Cells(xRow, i + 1) = strTempFieldValue
Else
.Cells(xRow, i + 1) = strFieldValue
End If
'Debug.Print strDisplayText

Next i
End With

oDoc.Close savechanges:=wdDoNotSaveChanges
Set oDoc = Nothing

'Get the next doc
strDocFiles = Dir
Loop

oWord.Quit
'Make sure you release object references.
Set oWord = Nothing
Set oDoc = Nothing

'Select the whole Excel sheet and expand all the columns
wsWorkSheet.Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
ActiveWorkbook.Save

Exit Sub

Err_Handler:
Select Case Err
Case -2147022986, 429
Set oWord = CreateObject("Word.Application")
Resume Next
Case 5121, 5174
MsgBox "You must select a valid Word document. " & "No data imported.", vbOKOnly, "Document Not Found"
Case 5941
MsgBox Err.Description
' 'MsgBox "The document you selected does not " _
' & "contain the required form fields. " _
' & "No data imported.", vbOKOnly, _
' "Fields Not Found"
Case Else
MsgBox Err & ": " & Err.Description
oWord.Quit
End Select
End Sub

[Kenneth Hobs]

Are you sure that it is a formfield and not a content control?

Itellisense will tell if the property exists if you use early binding.

IF you make a short example file to test, it is easier to help. This lets you help us help you and isolate an issue.

'FormFields
' http://www.mrexcel.com/forum/showthread.php?p=1639696
' http://www.mrexcel.com/forum/showthread.php?t=333200
' http://www.excelforum.com/excel-programming/799070-import-text-fields-from-word.html
' Content Controls
' http://www.vbaexpress.com/forum/showthread.php?t=39654

[chieh]

Hi Kenneth:

Thank you for your suggestion. I did created a sample word form and the the sample vba macro. I have zip up these two test file, all you need is to unzip them to a temp folder and open the sample wordextract.xls to see my code and run the test.

Thanks
Chieh

[Kenneth Hobs]

What is the password?

I don't see any bookmarks nor captions. Obviously, formfields do not have a Caption property as you can see when you type the last period in the following code. So, I don't know what caption you mean.
strFieldName = oDoc.FormFields(i).
I prefer MsgBox() over popup unless I want a delay time to dismiss.

I recommend always using Option Explicit as the first line of code in a Module. I set that in the Options of the VBE.

I notice that you might think that setting the Dim type for the last one in a line set the previous ones. It does not. If not specified, they are Dimmed as type Variant.

Option Explicit

Sub WordExtract()
'==
'Add Word object reference library.
'Tools->References - Check the Microsoft Word Object Libary box
Dim wbWorkBook As Workbook
Dim wsWorkSheet As Worksheet
Dim oWord As Word.Application
Dim WordWasNotRunning As Boolean
Dim oDoc As Word.Document
Dim varFileName As Variant
Dim intHeaderRow As Integer, intNumberOfField As Integer, i As Integer
Dim intFileProcessed As Integer
Dim strPath As String, strDocFiles As String, strDisplayText As String
Dim strFullName As String, strFieldName As String, strFieldValue As String
Dim strFieldType As String
Dim strCaption As String, strTempFieldValue As String
Dim wsMessage As Object
Dim xRow As Long

Set wsMessage = CreateObject("WScript.Shell")
Set wbWorkBook = ActiveWorkbook
Set wsWorkSheet = wbWorkBook.Worksheets(1)
Range("A1").Select

'For FYI Info....
wsMessage.Popup " This Utility Only Works with *.Doc Files, Not the *.Docx, Press OK To Continue.... ", 5, _
"..... Information .....", 4096

'Get existing instance of Word if it's open; otherwise create a new one
On Error Resume Next
Set oWord = GetObject(, "Word.Application")
If Not Err Then
'Close the word instance if open
oWord.Quit
End If

Set oWord = New Word.Application
On Error GoTo Err_Handler

'Prompt user for the directory where all the word document are located.
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 1 Then
strPath = .SelectedItems(1)
End If
End With
If strPath = Empty Then
wsMessage.Popup "No folder Selected", 5, "..... Error .....", 4096
Exit Sub
End If

'Get the last row
xRow = wsWorkSheet.Range("A" & Rows.Count).End(xlUp).Row
'Append new Row.....
xRow = xRow + 2

'Keep track number of word document processed
intFileProcessed = 0

'Retreive list of all the word doc files in the given directory
'For now this only works with *.Doc files only. Not the *.Docx, as we only have word office 2003 installed.
'It can be change easily to accomodiate the new docx format.
strDocFiles = Dir(strPath & "\*.Doc")

' Loop through all the word document in this directory, retrieve the info and insert it into the excel sheet.
Do While strDocFiles <> ""
intFileProcessed = intFileProcessed + 1

'Prompt to select single file
'varFileName = Application.GetOpenFilename("Word Files (*.doc; *.docx), *.doc; *.docx")
'varFileName = Application.GetOpenFilename("Word Files (*.doc; *.docx), *.doc; *.docx", , , 1)
'Prompt to select a directory (More than one word file)
Set oDoc = oWord.Documents.Open(strPath & "\" & strDocFiles, Visible:=False)

With wsWorkSheet
'Get the Total Number of user fillable TextBox field in this Document
intNumberOfField = oDoc.FormFields.Count

'Get the Full Name of the current word document
strFullName = oDoc.FullName

'Display processing info in the popup window.....
strDisplayText = "Processing..... " & strFullName & " - Total Field Count: " & Trim(Str(intNumberOfField))
wsMessage.Popup strDisplayText, 1, "Processing", 4096

'If this is the first file being processed, retrieve the header too..
'At this point, haven't figure out how to retrieve the textbox title/label, so just retrieve the actual object name
If intFileProcessed = 1 Then
'Loop through all the fillable fields
For i = 1 To intNumberOfField
strCaption = ""
'Retrieve field object Name and insert/update into Excel cell
strFieldName = oDoc.FormFields(i).Name
'The following commented out line: Trying to get the field caption, didn't work....
'strCaption = oDoc.Bookmarks(strFieldName).Range.Text
'.Cells(xRow, i + 1) = strFieldName & " - " & strCaption

wsWorkSheet.Activate
.Cells(xRow, i + 1) = strFieldName
Next i

'Save the header row # for setting them to Bold after all the files is run.
intHeaderRow = xRow
'Add date and time stamp to first column in the header row
.Cells(xRow, 1).Select
Selection.Value = Now()
Selection.HorizontalAlignment = xlLeft
End If

'Append new Row.....
xRow = xRow + 1

'Update the full name of the word doc in the first column of the current row
wsWorkSheet.Activate
.Cells(xRow, 1) = strFullName

'Retrieve the fillable field result for the current document.
For i = 1 To intNumberOfField
'Retrieve Full Filename, field type, field name and fieldvalue
strFieldType = oDoc.FormFields(i).Type
strFieldName = oDoc.FormFields(i).Name
strFieldValue = oDoc.FormFields(i).Result

'Display processing info in the popup window.....
'strDisplayText = "Processing..... " & strFullName & " - Total Field Count: " & Trim(Str(intNumberOfField)) _
'& ", _Current Field: " & Trim(Str(i)) & " - " & strFieldName & ", Field Value: " & strFieldValue
'wsMessage.Popup strDisplayText, 1, "Processing", 4096

' Type "wdFieldFormCheckBox" = 71, if it's a check box, the value store is either "1" or "0" for true or false
' the following converts "1" to "True" and "0" to "False" for easier understanding by the users.
If strFieldType = 71 Then
Select Case strFieldValue
Case "0"
strTempFieldValue = "No"
Case "1"
strTempFieldValue = "Yes"
End Select
wsWorkSheet.Activate
.Cells(xRow, i + 1) = strTempFieldValue
Else
wsWorkSheet.Activate
.Cells(xRow, i + 1) = strFieldValue
End If
'Debug.Print strDisplayText

Next i
End With

oDoc.Close savechanges:=wdDoNotSaveChanges
Set oDoc = Nothing

'Get the next doc
strDocFiles = Dir
Loop

oWord.Quit
'Make sure you release object references.
Set oWord = Nothing
Set oDoc = Nothing

'Set the header row to Bold font only
wsWorkSheet.Activate
wsWorkSheet.Cells.Select
Selection.Font.Bold = False
Rows(intHeaderRow & ":" & intHeaderRow).Select
Selection.Font.Bold = True

'Select the whole Excel sheet and expand all the columns
wsWorkSheet.Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
ActiveWorkbook.Save
Exit Sub

Err_Handler:
Select Case Err
Case -2147022986, 429
Set oWord = CreateObject("Word.Application")
Resume Next
Case 5121, 5174
MsgBox "You must select a valid Word document. " & "No data imported.", vbOKOnly, "Document Not Found"
Case 5941
MsgBox Err.Description
' 'MsgBox "The document you selected does not " _
' & "contain the required form fields. " _
' & "No data imported.", vbOKOnly, _
' "Fields Not Found"
Case Else
MsgBox Err & ": " & Err.Description
oWord.Quit
End Select
End Sub

[chieh]

Hi Kenneth:

Thank you for your response and suggestions, I will make those changes in my code.

First, the password for the macro is "craroc" without quote, (am sure this is the one, if not try "test")

I guess I didn't quite explain it very well.

Let say I have 5 word forms.

Each form has the following:

test1.doc
First Name [Chieh ]
Last Name [zh ]
Address [ 123 anywhere street]
;
;
;
test2.doc
First Name [Peter Smith ]
Last Name [King ]
Address [ 123 King Street]
;
;
;
and so on...

and after I run through my vba code in Excel, it will populate all the info from the word doc to excel sheet row by row... And I am trying to get the text label / or caption infront of each textbox i.e. "First Name", "Last Name", "Address", ..... and use it as column heading....

i.e. in my Excel sheet, after running the program the row should look like this:

Cell |A | B | C | D |E
-----------------------------------------------------------------------
Row 1 |Now() | txtFirstName | txtLastName | txtAddress
Row 2 |Test1.doc |Chieh |Zh |123 anywhere st..
Row 3 |Test2.doc |Peter Smith |KIng |123 king street
Row 4 |Test3.doc ..... ..... ...
Row 5 |Test4.doc ..... ..... ...


at this point, the program is using oDoc.FormFields(i).Name
to get the actual object name, i.e. txtFirstName, TxtLastName and use it as heading for First Row, I want the first row to look like the following.... using the caption or label instead of the txtFirstName, txt.., txt....

Row 1 |Now() | First Name | Last Name | Address

Hopefully I have explained this more clearly.

Thank you again.

[Kenneth Hobs]

I think what you are saying is that you want the value in the table cell to the left of the table cell that contains the formfield? I have not worked with MSWord tables much so it will take a bit of research. You can use doc.Selection.Information(wdWithinTable) to see if the current selection range is in a table.