Import word form to excel macro

[onsight]

Hello,

I use this macro to import word form data to excel. I find this macro online. Macro works fine with form textfields, but in my form are some dropdown lists and macro in excel put some squares instead of values. Can someone help me, what should I change in code that will import dropdown list values to?

Here is macro:

Sub getWordFormData()
Dim wdApp As New Word.Application
Dim myDoc As Word.Document
Dim FmFld As Word.FormField
Dim myFolder As String, strFile As String
Dim myWkSht As Worksheet, i As Long, j As Long
myFolder = "C:\Users\oddelek.a\Desktop\Testna"
Application.ScreenUpdating = False
If myFolder = "" Then Exit Sub
Set myWkSht = ActiveSheet
Range("A1") = "Vrstaporočila"
Range("A1").Font.Bold = True
Range("B1") = "Priimek"
Range("B1").Font.Bold = True
Range("C1") = "Ime"
Range("C1").Font.Bold = True
Range("D1") = "Rojstnipodatki"
Range("D1").Font.Bold = True
Range("E1") = "Datum"
Range("E1").Font.Bold = True
Range("F1") = "Ura"
Range("F1").Font.Bold = True
Range("G1") = "Izmena"
Range("G1").Font.Bold = True
Range("H1") = "Služba"
Range("H1").Font.Bold = True
Range("I1") = "Status"
Range("I1").Font.Bold = True
Range("J1") = "Mesto"
Range("J1").Font.Bold = True
Range("K1") = "Vrsta"
Range("K1").Font.Bold = True
i = myWkSht.Cells(myWkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(myFolder & "\*.doc", vbNormal)

While strFile <> ""
i = i + 1
Set myDoc = wdApp.Documents.Open(Filename:=myFolder & "" & strFile, AddToRecentFiles:=False, Visible:=False)
With myDoc
j = 0
For Each FmFld In .FormFields
j = j + 1
myWkSht.Cells(i, j) = FmFld.Range
Next
myWkSht.Columns.AutoFit
End With
myDoc.Close SaveChanges:=False
strFile = Dir()
Wend
wdApp.Quit
Set myDoc = Nothing: Set wdApp = Nothing: Set myWkSht = Nothing
Application.ScreenUpdating = True

End Sub

[Leith Ross]

Hello onsight,

In versions of Word after 2007, there are three types of control collections: FormField, InlineShapes (Active X), and the newest ContentControls.

The only types of InlineShapes that accept user input are TextBox, ComboBox, and ListBox.

Examples for Checking for different Collections...




' // Check for Content Controls
With wdDoc.ContentControls(cnt)
Select Case .Type
Case Is = 0: Rng.Value = .Range.Text: Set Rng = Rng.Offset(0, 1) ' Rich TextBox
Case Is = 1: Rng.Value = .Range.Text: Set Rng = Rng.Offset(0, 1) ' Plain TextBox
Case Is = 3: Rng.Value = .Range.Text: Set Rng = Rng.Offset(0, 1) ' ComboBox
Case Is = 4: Rng.Value = .Range.Text: Set Rng = Rng.Offset(0, 1) ' DropDown List
Case Is = 6: Rng.Value = .Range.Text: Set Rng = Rng.Offset(0, 1) ' Date Picker
End Select
End With

' // Check for Active X Controls
If wdDoc.InlineShapes(cnt).Type = 5 Then
Select Case Split(wdDoc.InlineShapes(cnt).OLEFormat.progID, ".")(1)
Case Is = "TextBox", "ComboBox", "ListBox"
Rng.Value = wdDoc.InlineShapes(cnt).OLEFormat.Object.Value
Set Rng = Rng.Offset(0, 1)
End Select
End If

' // Check for FormField Controls.
With wdDoc.FormFields(cnt)
Select Case .Type
Case Is = 70: Rng.Value = .TextInput.Format: Set Rng = Rng.Offset(0, 1)
Case Is = 71: Rng.Value = .CheckBox.Value: Set Rng = Rng.Offset(0, 1)
Case Is = 83: Rng.Value = .DropDown.Value: Set Rng = Rng.Offset(0, 1)
End Select
End With

[onsight]

Thank you for answer. I m not VBA specialist and I dont know, how to use your answer correctly. Can you show me on my macro, how I must change macro to import dropdown list values to? Please?

[onsight]

Hello onsight,

In versions of Word after 2007, there are three types of control collections: FormField, InlineShapes (Active X), and the newest ContentControls.

The only types of InlineShapes that accept user input are TextBox, ComboBox, and ListBox.

Examples for Checking for different Collections...




' // Check for Content Controls
With wdDoc.ContentControls(cnt)
Select Case .Type
Case Is = 0: Rng.Value = .Range.Text: Set Rng = Rng.Offset(0, 1) ' Rich TextBox
Case Is = 1: Rng.Value = .Range.Text: Set Rng = Rng.Offset(0, 1) ' Plain TextBox
Case Is = 3: Rng.Value = .Range.Text: Set Rng = Rng.Offset(0, 1) ' ComboBox
Case Is = 4: Rng.Value = .Range.Text: Set Rng = Rng.Offset(0, 1) ' DropDown List
Case Is = 6: Rng.Value = .Range.Text: Set Rng = Rng.Offset(0, 1) ' Date Picker
End Select
End With

' // Check for Active X Controls
If wdDoc.InlineShapes(cnt).Type = 5 Then
Select Case Split(wdDoc.InlineShapes(cnt).OLEFormat.progID, ".")(1)
Case Is = "TextBox", "ComboBox", "ListBox"
Rng.Value = wdDoc.InlineShapes(cnt).OLEFormat.Object.Value
Set Rng = Rng.Offset(0, 1)
End Select
End If

' // Check for FormField Controls.
With wdDoc.FormFields(cnt)
Select Case .Type
Case Is = 70: Rng.Value = .TextInput.Format: Set Rng = Rng.Offset(0, 1)
Case Is = 71: Rng.Value = .CheckBox.Value: Set Rng = Rng.Offset(0, 1)
Case Is = 83: Rng.Value = .DropDown.Value: Set Rng = Rng.Offset(0, 1)
End Select
End With





Thank you for answer. I m not VBA specialist and I dont know, how to use your answer correctly. Can you show me on my macro, how I must change macro to import dropdown list values to? Please?

[Leith Ross]

Hello onsight,

Are the only controls in the Word Document FormField TextBoxes and FormField DropDowns?

[onsight]

Hello onsight,

Are the only controls in the Word Document FormField TextBoxes and FormField DropDowns?

Yes, only textfields and dropdown lists are in the document. This macro I copy paste from internet tutorial works fine, text fileds are imported to excel, dropdown list values are not. Can you help me?

[gmayor]

Maybe https://www.gmayor.com/ExtractDataFromForms.htm will help?

[onsight]

Maybe https://www.gmayor.com/ExtractDataFromForms.htm will help?

I work in hospital as nurse and I cant install anything on our computer, so the add on can be problem. I need this for analyzing incidents and patient falling of the bed in our hospital. So...there is no way to modify macro I send in my post? Like I said, macro do exactly what I need. I have form with text form fields and dropdown lists. Dropdown lists are populated depend in first dropdown list, so this single form can be used for several incidents.
When I import word form data with this macro in my post, all text fields are imported correctly, all dropdown fields are not imported. Instead of data excel put in columns squares. Is something missing in macro or what? I will be very grateful for help.

[macropod]

The extraction of formfield & content control data from Word to Excel has been discussed numerous times. See, for example:
http://www.vbaexpress.com/forum/showthread.php?40406-Extracting-Word-form-Data-and-exporting-to-Excel-spreadsheet&p=257696&viewfull=1#post257696
and, further down in the same thread:
http://www.vbaexpress.com/forum/showthread.php?40406-Extracting-Word-form-Data-and-exporting-to-Excel-spreadsheet&p=291047&viewfull=1#post291047

[gmayor]

If these are legacy form fields as appears to be the case, change

myWkSht.Cells(i, j) = FmFld.Range
to

myWkSht.Cells(i, j) = FmFld.Result

[onsight]

If these are legacy form fields as appears to be the case, change

myWkSht.Cells(i, j) = FmFld.Range
to

myWkSht.Cells(i, j) = FmFld.Result

Hello,

thank you, I change macro as you said and now all fields are imported to excel. But something else is now wrong. Now when I run macro, alert window show run-time error 5825, I select End and excel import only one file data, if I click debug, this line is yellow: myWkSht.Cells(i, j) = FmFld.Result.
And word program keep running in background. I send both files, so you can see for yourself.

I think I find a problem. Runtime error report every time, when word form is not completly filled. When one field is left empty, then macro stop importing data. Problem is, that form wil many times have some fields empty. Can someone know, how change macro that will skip empty fields and continue importing?

[onsight]

Maybe https://www.gmayor.com/ExtractDataFromForms.htm will help?


I try this add on and have same problem like with macro...if form have empty fields, alert window for runtime error shows up. Import only ful filled forms.
Any solution for this?

[gmayor]

You can either trap empty fields in your document or you can trap them in the extraction macro. With your original Excel code the following should work


Sub getWordFormData()Dim wdApp As Object
Dim myDoc As Object
Dim bStart As Boolean
Dim FmFld As Object
Dim oFSO As Object
Dim myFolder As String, strFile As String
Dim myWkSht As Worksheet, i As Long, j As Long
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err Then
Set wdApp = CreateObject("Word.Application")
bStart = True
End If
On Error GoTo 0
Set oFSO = CreateObject("Scripting.FileSystemObject")
myFolder = Environ("USERPROFILE") & "\Desktop\Testna\"
If Not oFSO.FolderExists(myFolder) Then GoTo lbl_Exit
Application.ScreenUpdating = False
Set myWkSht = ActiveSheet
Range("A1") = "Vrstaporocila"
Range("A1").Font.Bold = True
Range("B1") = "Priimek"
Range("B1").Font.Bold = True
Range("C1") = "Ime"
Range("C1").Font.Bold = True
Range("D1") = "Rojstnipodatki"
Range("D1").Font.Bold = True
Range("E1") = "Datum"
Range("E1").Font.Bold = True
Range("F1") = "Ura"
Range("F1").Font.Bold = True
Range("G1") = "Izmena"
Range("G1").Font.Bold = True
Range("H1") = "Služba"
Range("H1").Font.Bold = True
Range("I1") = "Status"
Range("I1").Font.Bold = True
Range("J1") = "Mesto"
Range("J1").Font.Bold = True
Range("K1") = "Vrsta"
Range("K1").Font.Bold = True
i = myWkSht.Cells(myWkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(myFolder & "*.doc", vbNormal)
While strFile <> ""
i = i + 1
Set myDoc = wdApp.Documents.Open(FileName:=myFolder & strFile, AddToRecentFiles:=False, Visible:=False)
With myDoc
j = 0
For Each FmFld In .FormFields
j = j + 1
On Error GoTo err_Handler
myWkSht.Cells(i, j) = FmFld.Result
Next
myWkSht.Columns.AutoFit
End With
myDoc.Close SaveChanges:=False
strFile = Dir()
Wend
lbl_Exit:
If bStart = True Then wdApp.Quit
Set myDoc = Nothing: Set wdApp = Nothing: Set myWkSht = Nothing: Set oFSO = Nothing
Application.ScreenUpdating = True
Exit Sub
err_Handler:
If Err.Number = 5825 Then
Resume Next
Else
MsgBox Err.Number & vbCr & Err.Description
GoTo lbl_Exit
End If
End Sub

[onsight]

You can either trap empty fields in your document or you can trap them in the extraction macro. With your original Excel code the following should work


Sub getWordFormData()Dim wdApp As Object
Dim myDoc As Object
Dim bStart As Boolean
Dim FmFld As Object
Dim oFSO As Object
Dim myFolder As String, strFile As String
Dim myWkSht As Worksheet, i As Long, j As Long
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err Then
Set wdApp = CreateObject("Word.Application")
bStart = True
End If
On Error GoTo 0
Set oFSO = CreateObject("Scripting.FileSystemObject")
myFolder = Environ("USERPROFILE") & "\Desktop\Testna\"
If Not oFSO.FolderExists(myFolder) Then GoTo lbl_Exit
Application.ScreenUpdating = False
Set myWkSht = ActiveSheet
Range("A1") = "Vrstaporocila"
Range("A1").Font.Bold = True
Range("B1") = "Priimek"
Range("B1").Font.Bold = True
Range("C1") = "Ime"
Range("C1").Font.Bold = True
Range("D1") = "Rojstnipodatki"
Range("D1").Font.Bold = True
Range("E1") = "Datum"
Range("E1").Font.Bold = True
Range("F1") = "Ura"
Range("F1").Font.Bold = True
Range("G1") = "Izmena"
Range("G1").Font.Bold = True
Range("H1") = "Služba"
Range("H1").Font.Bold = True
Range("I1") = "Status"
Range("I1").Font.Bold = True
Range("J1") = "Mesto"
Range("J1").Font.Bold = True
Range("K1") = "Vrsta"
Range("K1").Font.Bold = True
i = myWkSht.Cells(myWkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(myFolder & "*.doc", vbNormal)
While strFile <> ""
i = i + 1
Set myDoc = wdApp.Documents.Open(FileName:=myFolder & strFile, AddToRecentFiles:=False, Visible:=False)
With myDoc
j = 0
For Each FmFld In .FormFields
j = j + 1
On Error GoTo err_Handler
myWkSht.Cells(i, j) = FmFld.Result
Next
myWkSht.Columns.AutoFit
End With
myDoc.Close SaveChanges:=False
strFile = Dir()
Wend
lbl_Exit:
If bStart = True Then wdApp.Quit
Set myDoc = Nothing: Set wdApp = Nothing: Set myWkSht = Nothing: Set oFSO = Nothing
Application.ScreenUpdating = True
Exit Sub
err_Handler:
If Err.Number = 5825 Then
Resume Next
Else
MsgBox Err.Number & vbCr & Err.Description
GoTo lbl_Exit
End If
End Sub


Thank you soooo much. Works like....!!! Thanks again.