Consulting

Results 1 to 15 of 15

Thread: Sleeper: Can anyone help me with this code ?

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

    Sleeper: Can anyone help me with this code ?

    Exporting Word Form Data to Excel
    https://www.youtube.com/watch?v=1x-Vk4Qmpz0

  2. #2
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    552
    Location
    Hello foi123,

    Your question is about code but you posted a video link and not a workbook with code in it. So, what is it you want to do?
    Sincerely,
    Leith Ross

    "1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"

  3. #3
    VBAX Regular
    Joined
    Jun 2019
    Posts
    8
    Location
    its just that the guy in the video gave me the link to this website ?

  4. #4
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    552
    Location
    Hello foi123,

    Okay, do you have Word files with input fields? Do you want to transfer the input data from the Word document to an Excel worksheet?
    Sincerely,
    Leith Ross

    "1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"

  5. #5
    VBAX Regular
    Joined
    Jun 2019
    Posts
    8
    Location
    yes i need to transfer multiple word documents into a excel worksheet and and the guy said you can copy and paste the code from here ?

  6. #6
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    552
    Location
    Hello foxi123,

    It took me some time to find the code. Here it is...

    'This macro finds multiple Word files in a folder, and pulls the values from all hte fields in them. It
    'will append any new information to the 'bottom of the sheet.
    '
    'if you decide to use Content Controls instead of Form Fields (using the top section of the Developer
    'Ribbon, you will need to find every instance of FormField and replace it with Control.
    '
    'Dim FmFld As Word.FormField changes to
    'Dim CCtrl as Word.ContentControl
    '
    'For Each FmFld In.FormFields changes
    'For Each CCtrl in .ContentControls
    
    
    Sub GetFormData_CCF()
    'Note: this code requires a reference to the Word object model
     Application.ScreenUpdating = False
     Dim wdApp As New Word.Application
    'For New Word.Application, remember go to Tools, References
    'enable the options- Microsoft Word 1# Object Library
    
    
     Dim wdDoc As Word.Document
     Dim CCtrl As Word.ContentControl
     Dim strFolder As String, strFile As String
     Dim WkSht As Worksheet, i As Long, j As Long
     strFolder = GetFolder
     If strFolder = "" Then Exit Sub
     Set WkSht = ActiveSheet
     i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).row
    
    
    'on this line, notice that the file extension is .docx.
    'if you are using .doc files or .docm files, make sure
    'you change this line to match up with that.
     strFile = Dir(strFolder & "\*.docx", vbNormal)
     While strFile <> ""
     i = i + 1
     Set wdDoc = wdApp.Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
     With wdDoc
     j = 0
     For Each CCtrl In .ContentControls
     j = j + 1
     WkSht.Cells(i, j) = CCtrl.Range.Text
     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 GetFolder() As String
     Dim oFolder As Object
     GetFolder = ""
     Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
     If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
     Set oFolder = Nothing
    End Function
    
    
    Sub GetFormData_LF()
     Application.ScreenUpdating = False
     Dim wdApp As New Word.Application
    
    
     Dim wdDoc As Word.Document
     Dim CCtrl As Word.ContentControl
     Dim strFolder As String, strFile As String
     Dim WkSht As Worksheet, i As Long, j As Long
     strFolder = GetFolder
     If strFolder = "" Then Exit Sub
     Set WkSht = ActiveSheet
     i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).row
     strFile = Dir(strFolder & "\*.docx", vbNormal)
     While strFile <> ""
     i = i + 1
     Set wdDoc = wdApp.Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
     With wdDoc
     j = 0
     For Each FmFld In .FormFields
     j = j + 1
     WkSht.Cells(i, j) = FmFld.Range.Text
     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
    
    
    ' Step 2: Start Excel
    ' Step 3: Create a new blank workbook by pressing Ctrl N
    ' Step 4: Save it as a new file name and the file extension is Macro Enabled Workbook
    ' Step 5: Press Alt F11 to VBA editor screen
    ' Step 6: Press Ctrl V, paste the VBA code in your new module.
    
    
    ' To run the macro, click View, Macro, View
    Sincerely,
    Leith Ross

    "1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"

  7. #7
    VBAX Regular
    Joined
    Jun 2019
    Posts
    8
    Location
    Thank you so much i will try this out i really appreciate it!

  8. #8
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    552
    Location
    Hello foxi123,

    You're welcome.
    Sincerely,
    Leith Ross

    "1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"

  9. #9
    VBAX Regular
    Joined
    Jun 2019
    Posts
    8
    Location
    seem to be getting an error when clicking the button i make. Compile Error User defined-type not defined
    Sub GetFormData_LF()
     Application.ScreenUpdating = False
     Dim wdApp As New Word.Application

  10. #10
    VBAX Regular
    Joined
    Jun 2019
    Posts
    8
    Location
    Sub GetFormData_CCF()
    'Note: this code requires a reference to the Word object model
    Application.ScreenUpdating = False
    Dim wdApp As New Word.Application
    'For New Word.Application, remember go to Tools, References
    'enable the options- Microsoft Word 1# Object Library

    when i go into tool i have Microsoft Word 16.0 Object Library is enabled ?

  11. #11
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    552
    Location
    Hello foxi123,

    What version of Office are you using? Which operating system are using?
    Sincerely,
    Leith Ross

    "1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"

  12. #12
    VBAX Regular
    Joined
    Jun 2019
    Posts
    8
    Location
    running Windows 10 and i thinks its Microsoft office pro plus 2016

  13. #13
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    552
    Location
    Hello foxi123,

    I decided the best course of action was to create a new and improved version of this macro. This version will check both doc and docx files in the selected folder. The macro will then check each document for input controls. Word has three different types: Content Controls, Active X Controls, and legacy Forms Field Controls.

    The macro will take the data from each control as they appear in the document, regardless of type, and copy the data into a column of the worksheet. The next column to the right is then used for the next control etc. When no more controls are found, the macro moves on to the next row and the next Word document.

    Here is the macro code...

    Option Explicit
    
    
    ' Author:   Leith Ross
    ' Written:  June 14, 2019
    ' Summary:  Import input control values from either DOC or DOCX Word files
    '           to a worksheet. Each row represents a single document's controls.
    '           The number of columns can vary based on the number of controls
    '           in the Word Document.
    
    
    Sub ImportWordControlsData()
    
    
        Dim cnt     As Long
        Dim Done    As Long
        Dim index   As Variant
        Dim oFiles  As Object
        Dim oFolder As Object
        Dim oShell  As Object
        Dim Path    As Variant
        Dim Rng     As Range
        Dim RngBeg  As Range
        Dim RngEnd  As Range
        Dim wdApp   As Object
        Dim wdDoc   As Object
        Dim Wks     As Worksheet
        
            Set Wks = ActiveSheet
            Set RngBeg = Wks.Range("A2")
            Set RngEnd = Wks.Cells(Rows.Count, "A").End(xlUp)
            
            If RngEnd.Row < RngBeg.Row Then Set Rng = RngBeg Else Set Rng = RngEnd.Offset(1, 0)
            
            Set oShell = CreateObject("Shell.Application")
            
            Set wdApp = CreateObject("Word.Application")
                
            With Application.FileDialog(msoFileDialogFolderPicker)
                If .Show = -1 Then Path = .SelectedItems(1) Else Exit Sub
            End With
            
                Set oFolder = oShell.Namespace(Path)
                Set oFiles = oFolder.Items
                    oFiles.Filter 64, "*.doc;*.docx"
                
                For index = 0 To oFiles.Count - 1
                    Set wdDoc = wdApp.Documents.Open(Filename:=oFiles.Item(index).Path, Visible:=True)
                    
                    cnt = 0
                    Done = 7
                    
                    Do
                        DoEvents
                        cnt = cnt + 1
                        
                        ' // Check for Content Controls
                        If cnt <= wdDoc.ContentControls.Count Then
                            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
                        Else
                            Done = Done And 3
                        End If
                        
                        ' // Check for Active X Controls
                        If cnt <= wdDoc.InlineShapes.Count Then
                            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
                        Else
                            Done = Done And 5
                        End If
                        
                        ' // Check for Legacy Form Controls.
                        If cnt <= wdDoc.FormFields.Count Then
                            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
                        Else
                            Done = Done And 6
                        End If
                        
                        If Done = 0 Then Exit Do
                    Loop
                    
                    Set Rng = Rng.Offset(1, 0)
                    wdDoc.Close SaveChanges:=False
                Next index
                
            wdApp.Quit
            MsgBox "Finished Importing Documents."
            
    End Sub
    Sincerely,
    Leith Ross

    "1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"

  14. #14
    VBAX Regular
    Joined
    Jun 2019
    Posts
    8
    Location
    Wow thanks for this it is now working not getting the error message but when i click on the button and go to the folder where my word docs are it says "no items match your search" ?

  15. #15
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    552
    Location
    Hello foxi123,

    That's interesting. The macro I wrote does not produce that message. If you post a copy of the workbook then I could troubleshoot the code and get it working.
    Sincerely,
    Leith Ross

    "1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"

Posting Permissions

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