Word Form data to Excel

[Bill4tektips]

Does anyone know if it is possible to take data from a Word Form and import it into Excel?

I have to create a Questionnaire Form to send to around 500 people and I would like the responses to go into an Excel Spreadsheet for data analysis. Can anyone advise on the best way to go about it?

 

[SkipVought]

The simplest way is to do the entire thing in Excel.

You need to carefully design the "form" to make data acquisition and analysis as simple as possible.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[macropod]

Hi Bill,

If your document is well structured and uses formfields and/or tables to collate the data, then extracting the records you want isn't too difficult. The following Word macros extract the data to a delimted text (csv) file that you could open in Excel.

The code is from a project I completed a while back for a similar task - extracting data from 150 documents protected for forms, each potentially containing data in 200 formfields and 185 unprotected sections (which meant the data had to be transposed for older versions of Excel). Infact, the code outputs two versions of the file - a txt file that isn't transposed and a csv file that is. A simple change to the file extensions in the 'Main' sub's code will swap this arrangement around.

Option Explicit             ' Ensures variables are properly declared before use
Dim OutText As String       ' Storage for the output data
Dim DataArry(151, 385)      ' Storage for the output data; includes an extra field for header
Dim iDiv As Integer         ' Division Index

Function GetFolder(Optional Title As String, Optional RootFolder As Variant) As String
' This function uses the windows shell to select the working folder
' Any errors caused by not selecting a folder are handled by the calling routine
On Error Resume Next
GetFolder = CreateObject("Shell.Application").BrowseForFolder(0, Title, 0, RootFolder).Items.Item.Path
End Function

Sub Main()
Dim SourceFolder
Dim TargetFolder
Dim TargetFile
OutText = ""
iDiv = 0
' Get to folder containing the data files
SourceFolder = GetFolder(Title:="Select Survey Response Folder")
TargetFolder = SourceFolder
' Alternatively, to select a different output folder, uncomment the next line
' TargetFolder = GetFolder(Title:="Select Evaluation Output Folder")
TargetFile = TargetFolder & "\Survey Data File"
' Check that a source folder has been selected
If SourceFolder <> "" Then
    'Process the data files
    Call GetFiles(SourceFolder)
Else
    MsgBox " No Source Folder Selected!"
    GoTo Abort
End If
' Check that an output folder has been selected
If TargetFolder <> "" Then
    ' Delete any pre-existing copies of the data files
    If Dir(TargetFile & ".txt") <> "" Then Kill (TargetFile & ".txt")
    If Dir(TargetFile & ".csv") <> "" Then Kill (TargetFile & ".csv")
    ' Write the data to new data files
    Call WriteFile(TargetFile & ".txt", OutText)
    Call Transpose
    Call WriteFile(TargetFile & ".csv", OutText)
Else
    MsgBox " No Target Folder Selected!"
End If
Abort:
End Sub

Sub GetFiles(SourceFolder)
' This sub processes all files in the called folder
Dim fs, ff
Dim FileCount As Integer
Dim i As Integer
Set fs = Application.FileSearch
With fs
    ' Where to look
    .LookIn = SourceFolder
    ' What kind of file to look for
    .FileName = "*.doc"
    ' Sort the files and check how many
    If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
        ' Store and report the number of files matching the 'kind' criteria
        FileCount = .FoundFiles.Count
        MsgBox FileCount & " file(s) were found."
        ' process all matching files
        For i = 1 To FileCount
            ff = fs.FoundFiles(i)
            ' Open the file
            Application.Documents.Open FileName:=ff, AddToRecentFiles:=False
            ' Get the data
            Call GetData(SourceFolder)
        Next i
    Else
        MsgBox "There were no files found."
    End If
End With
End Sub

Sub GetData(SourceFolder)
Dim i As Integer
Dim iRec As Integer
Dim PSctn As Integer
Dim oSctn As Section
Dim oRng As Range
Dim oTbl As Table
Dim oCel As Cell
Dim oFld As FormField
Dim oStr As String
' Turn Off Screen Updating
Application.ScreenUpdating = False
With ActiveDocument
    ' Apply protection if the document is unprotected
    If .ProtectionType = wdNoProtection Then .Protect Type:=wdAllowOnlyFormFields, NoReset:=True
    PSctn = 0
    For i = 1 To .Sections.Count
        ' Get a count of the protected sections
        If .Sections(i).ProtectedForForms = True Then PSctn = PSctn + 1
    Next i
    ' Check that we've got the right numbers of sections, protected sections and formfields
    If .Sections.Count <> 369 Then
        MsgBox .Name & " is invalid - incorrect section count."
    ElseIf PSctn <> 185 Then
        MsgBox .Name & " is invalid - incorrect protected section count."
    ElseIf .FormFields.Count <> 200 Then
        MsgBox .Name & " is invalid - incorrect formfield count."
    Else
        ' All is OK, so extract the data
        iDiv = iDiv + 1
        iRec = 1
        For Each oSctn In .Sections
            If oSctn.ProtectedForForms = False Then
                ' If the Section is unprotected, get everything
                Set oRng = oSctn.Range
                ' Code to process tables
                For Each oTbl In oRng.Tables
                    For Each oCel In oTbl.Range.Cells
                        ' If the cell is empty, insert an asterisk
                        If Trim(oCel.Range.Text) = vbCr & Chr(7) Then oCel.Range.Text = "*"
                    Next oCel
                Next oTbl
                ' Shorten the range to eliminate the final para mark
                oRng.MoveEnd Unit:=wdCharacter, Count:=-2
                ' replace table cell boundaries with "|" and replace table row ends & paragraph breaks with linefeeds
                oStr = """" & Trim(Replace(Replace(Replace(Replace(oRng.Text, vbCr & Chr(7), "|"), vbTab, " "), _
			vbCr, vbLf), "||", vbLf)) & """"
                ' Strip out all space padding
                Do While InStr(oStr, "  ") > 0
                    oStr = Replace(oStr, "  ", " ")
                Loop
                ' Add commas to separate the output data fields
                If Len(OutText) = 0 Then
                    OutText = oStr
                Else
                    OutText = OutText & "," & oStr
                End If
                ' Write the data to the DataArry
                DataArry(iDiv, iRec) = oStr
                iRec = iRec + 1
            Else
                ' If the Section is protected, get the fomfield results
                For Each oFld In oSctn.Range.FormFields
                    ' Add tabs to separate the output data fields
                    oStr = """" & Trim(Replace(Replace(Replace(Replace(oFld.Result, vbCr & Chr(7), "|"), _
			vbTab, " "), vbCr, vbLf), "||", vbLf)) & """"
                    If Len(OutText) = 0 Then
                        OutText = oFld.Result
                    Else
                        OutText = OutText & "," & oFld.Result
                    End If
                    ' Write the data to the DataArry
                    DataArry(iDiv, iRec) = oFld.Result
                    iRec = iRec + 1
                Next
            End If
        Next oSctn
        ' Clean up the first field for the 2nd & subsequent records, then add a
        ' carriage return to separate this file's data set from that of the next file
        OutText = Replace(OutText, vbCrLf & ",", vbCrLf) & vbCrLf
    End If
    ' Tell Word we haven't made any changes to the file, then close without saving
    .Saved = True
    .Close
End With
' Restore Screen Updating
Application.ScreenUpdating = True
End Sub

Sub WriteFile(TargetFile, OutText)
' Create and write to the output file
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Dim fs, f, ts, s
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CreateTextFile (TargetFile)          'Create a file
Set f = fs.GetFile(TargetFile)
Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)
ts.Write OutText ' Write the data to the file
ts.Close ' Close the file
End Sub

Private Sub Transpose()
Dim i As Integer
Dim j As Integer
OutText = ""
' Transpose the data in the DataArry
For i = 1 To 385
    For j = 1 To iDiv
        If j = 1 Then
            OutText = OutText & DataArry(j, i)
        ElseIf j = iDiv Then
            OutText = OutText & "," & DataArry(j, i) & vbCrLf
        Else
            OutText = OutText & "," & DataArry(j, i)
        End If
    Next j
Next i
End Sub

Sub TestForm()
' Test module for confirming the configuration of the Evaluation Template
' The output is a message displaying the filename, # Sections, # Protected Sections & # Formfields
' The # Sections, # Protected Sections & # Formfields must all be entered into the appropriate
' locations in the GetData sub
Dim i As Integer
Dim PSctn As Integer
With ActiveDocument
    ' Apply protection if the document is unprotected
    If .ProtectionType = wdNoProtection Then ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
    PSctn = 0
    For i = 1 To .Sections.Count
        ' Get a count of the protected sections
        If .Sections(i).ProtectedForForms = True Then PSctn = PSctn + 1
    Next i
    MsgBox .Name & vbCrLf & .Sections.Count & vbCrLf & PSctn & vbCrLf & .FormFields.Count
    .Fields.ToggleShowCodes
End With
End Sub

The last sub above (TestForm) can be used to test one of your forms for the counts that have to be used in the 'GetData' sub.

Because there was some uncertainty as to what the document's users might do in the unprotected sections, I had to allow for the possibility they might have inserted tables, multiple paragraphs, and so on, whilst each unprotected section consitutes just one data field.

Since this code is for MS Word, it can be driven with a MACROBUTTON field coded as {MACROBUTTON Main Run Data Extract} or something similar. If you run the main sub, you'll be prompted to select the folder containing the data files. Only valid MS Word data files are processed – a warning is given for any other MS Word files found in the folder. As implemented, the extracted data are written back to the same folder in a tab-delimited text file, but the code shows how a different destination folder can be used.

Where the respondent has created a multi-cell table as part of their response, the horizontal table cell boundaries are replaced with "|". Any tabs in the user’s response are replaced with spaces, and any double-space padding is replaced with single spaces. Any table row ends, line breaks & paragraph breaks in the user’s response are replaced with a pilcrow.

That should just about take care of anything you're likely to have.

Cheers

[MS MVP - Word]