Extract Data from Word to Excel
Thank you for the Code Macropod.
Code:
Sub GetFormData()
'Note: this code requires a reference to the Word object model.
'See under the VBE's Tools|References.
Application.ScreenUpdating = False
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim FmFld As Word.FormField, 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
'Disable any auto macros in the documents being processed
wdApp.WordBasic.DisableAutoMacros
strFile = Dir(strFolder & "\*.doc", 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
With FmFld
Select Case .Type
Case Is = wdFieldFormCheckBox
WkSht.Cells(i, j) = .CheckBox.Value
Case Else
If IsNumeric(FmFld.Result) Then
If Len(FmFld.Result) > 15 Then
WkSht.Cells(i, j) = "'" & FmFld.Result
Else
WkSht.Cells(i, j) = FmFld.Result
End If
Else
WkSht.Cells(i, j) = FmFld.Result
End If
End Select
End With
Next
For Each CCtrl In .ContentControls
With CCtrl
Select Case .Type
Case Is = wdContentControlCheckBox
j = j + 1
WkSht.Cells(i, j) = .Checked
Case wdContentControlDate, wdContentControlDropdownList, wdContentControlRichText, wdContentControlText
j = j + 1
If IsNumeric(.Range.Text) Then
If Len(.Range.Text) > 15 Then
WkSht.Cells(i, j).Value = "'" & .Range.Text
Else
WkSht.Cells(i, j).Value = .Range.Text
End If
Else
WkSht.Cells(i, j) = .Range.Text
End If
Case Else
End Select
End With
Next
.Close SaveChanges:=False
End With
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
The code works great, but there are two areas I am trying to fix. When the data is extracted to excel, it will bring in both checkbox results.
For example:
1. Question 1
Yes (checked)
No
When the code is ran, excel creates two columns, one for each option. One column shows TRUE (because it is checked), the column next to it shows FALSE(because it was not checked). I am trying to have only the checked answer be extracted into a single column. Also, instead of True and False, can it show Yes or No?
