Exporting Word Form Data to Excel
https://www.youtube.com/watch?v=1x-Vk4Qmpz0
Exporting Word Form Data to Excel
https://www.youtube.com/watch?v=1x-Vk4Qmpz0
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"
its just that the guy in the video gave me the link to this website ?
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"
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 ?
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"
Thank you so much i will try this out i really appreciate it!
Hello foxi123,
You're welcome.
Sincerely,
Leith Ross
"1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"
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
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 ?
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"
running Windows 10 and i thinks its Microsoft office pro plus 2016
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"
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" ?
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"