Exporting Word Form Data to Excel
https://www.youtube.com/watch?v=1x-Vk4Qmpz0
Printable View
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?
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?
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...
Code:'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
Thank you so much i will try this out i really appreciate it!
Hello foxi123,
You're welcome.
seem to be getting an error when clicking the button i make. Compile Error User defined-type not defined
Code: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?
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...
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
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.