This Microsoft Word Help & Tips page shows you how you can extract data from multiple forms and display the results in an Access database (or Word table).  For example, say you want to survey your friends, co-workers, or clients.  You first prepare an online (protected) form containing formfields for each survey question.  To keep this simple, the questions for this example are 1) Name, 2) Favorite Food,  and 3) Favorite Color.   You send out the forms via e-mail and ask the participants to complete and return the forms.  The easy part is over.  Now the forms start pouring in and you need to display the results.  Read on!

For information on preparing online (protected forms) and this topic in general, See the series of articles by Dian Chapman with this link:  Protected Forms

An example of our simple form is shown below.  It consist of three formfields bookmarked "Text1" "Text2" and "Text3." 

You will also need an Access database table with the appropriate fields to receive the data.  I called my database TestDataBase and for simplicity I saved it with my returned forms. 

Sub TallyData()

'Requires reference to MS ActiveX Data Objects 2.8 Library
Dim vConnection As New ADODB.Connection
Dim vRecordSet As New ADODB.Recordset
Dim oPath As String
Dim FileArray() As String
Dim oFileName As String
Dim i As Long
Dim myDoc As Word.Document
Dim FiletoKill As String
'Select the path containing the files to process
oPath = GetPathToUse
If oPath = "" Then
    MsgBox "A folder was not selected"
    Exit Sub
End If
'Create a subdirectory to store processed files if it doesn't exist.
CreateProcessedDirectory oPath
'Load file names into an array
oFileName = Dir$(oPath & "*.doc")
ReDim FileArray(1 To 1000) 'A number larger the expected number of replies
Do While oFileName <> ""
    i = i + 1
    FileArray(i) = oFileName
    'Get the next file name
   oFileName = Dir$
Loop
'Resize and preserve the array
ReDim Preserve FileArray(1 To i)
Application.ScreenUpdating = False
'Provide connection string for data using Jet Provider for Access database
vConnection.ConnectionString = "data source=E:\My Documents\Batch\TestDataBase.mdb;" & _
    "Provider=Microsoft.Jet.OLEDB.4.0;"
vConnection.Open
vRecordSet.Open "MyTable", vConnection, adOpenKeyset, adLockOptimistic
'Retrieve the data
vConnection.Execute "DELETE * FROM MyTable"
For i = 1 To UBound(FileArray)
    Set myDoc = Documents.Open(FileName:=oPath & FileArray(i), _
       Visible:=False)
    FiletoKill = oPath & myDoc 'Identify the file to move after processing
    vRecordSet.AddNew
    With myDoc
        If .FormFields("Text1").Result <> "" Then _
           vRecordSet("Name") = .FormFields("Text1").Result
        If .FormFields("Text2").Result <> "" Then _
           vRecordSet("Favorite Food") = .FormFields("Text2").Result
        If .FormFields("Text3").Result <> "" Then _
           vRecordSet("Favorite Color") = .FormFields("Text3").Result
        .SaveAs oPath & "Processed\" & .Name 'Save processed file in Processed folder
        .Close
        Kill FiletoKill 'Delete file from the batch folder
    End With
Next i
vRecordSet.Update
vRecordSet.Close
vConnection.Close
Set vRecordSet = Nothing
Set vConnection = Nothing
Application.ScreenUpdating = True
End Sub

Private Function GetPathToUse() As Variant
'Get the folder containing the files
'Note uses the "Copy Dialog" which enables the "open" option
With Dialogs(wdDialogCopyFile)
    If .Display <> 0 Then
        GetPathToUse = .Directory
    Else
        GetPathToUse = ""
        Exit Function
    End If
End With
If Left(GetPathToUse, 1) = Chr(34) Then
    GetPathToUse = Mid(GetPathToUse, 2, Len(GetPathToUse) - 2)
End If
End Function

Sub CreateProcessedDirectory(oPath As String)
'Requires Reference to Microsoft Scripting Runtime
Dim Path As String
Dim FSO As FileSystemObject
Path = oPath
Dim NewDir As String
Set FSO = CreateObject("Scripting.FileSystemObject")
NewDir = Path & "Processed"
If Not FSO.FolderExists(NewDir) Then
FSO.CreateFolder NewDir
End If
End Sub
    

I am including all four versions of the the code in the zip file as a record of my efforts to get my head around the processes illustrated.  Credit for a lot of the code and most of what I have learned putting this page together is due to outstanding assistance of some of the Word MVPs and regular newsgroup contributors.  Special thanks is due Doug Robbins for the Access piece, Jezebel for the Class piece, and Tony Jollans/Jonathan West for the array pieces.  Thank you all!

For more on Add-Ins and how to load them, see the heading "Organizing Global Templates" at:    Organizing Your Macros

Looking for something else?

	Enter your search terms Submit search form
	Web gregmaxey.mvps.org