Consulting

Results 1 to 14 of 14

Thread: Import word form to excel macro

  1. #1
    VBAX Regular
    Joined
    Jun 2019
    Posts
    8
    Location

    Import word form to excel macro

    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

  2. #2
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    504
    Location
    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
    Sincerely,
    Leith Ross

  3. #3
    VBAX Regular
    Joined
    Jun 2019
    Posts
    8
    Location
    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?

  4. #4
    VBAX Regular
    Joined
    Jun 2019
    Posts
    8
    Location
    Quote Originally Posted by Leith Ross View Post
    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?

  5. #5
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    504
    Location
    Hello onsight,

    Are the only controls in the Word Document FormField TextBoxes and
    FormField DropDowns?
    Sincerely,
    Leith Ross

  6. #6
    VBAX Regular
    Joined
    Jun 2019
    Posts
    8
    Location
    Quote Originally Posted by Leith Ross View Post
    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?

  7. #7
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  8. #8
    VBAX Regular
    Joined
    Jun 2019
    Posts
    8
    Location
    Quote Originally Posted by gmayor View Post
    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.

  9. #9
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,888
    Location
    The extraction of formfield & content control data from Word to Excel has been discussed numerous times. See, for example:
    http://www.vbaexpress.com/forum/show...l=1#post257696
    and, further down in the same thread:
    http://www.vbaexpress.com/forum/show...l=1#post291047
    Last edited by macropod; 06-25-2019 at 08:01 PM.
    Cheers
    Paul Edstein
    [MS MVP - Word]

  10. #10
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  11. #11
    VBAX Regular
    Joined
    Jun 2019
    Posts
    8
    Location
    Quote Originally Posted by gmayor View Post
    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?
    Attached Files Attached Files
    Last edited by macropod; 06-25-2019 at 08:03 PM.

  12. #12
    VBAX Regular
    Joined
    Jun 2019
    Posts
    8
    Location
    Quote Originally Posted by gmayor View Post

    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?

  13. #13
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  14. #14
    VBAX Regular
    Joined
    Jun 2019
    Posts
    8
    Location

    Thumbs up

    Quote Originally Posted by gmayor View Post
    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •