Elf,

I know a little about Word and practically nothing about Excel. Maybe
we can help each other out.

Here is a bit of code that I cobbled together that extracts data from a
couple of form fields, stores it in a dataobject (I don't know if it is
Excel or not) then reports the compiled data in a Word table. All you
have to do is put all of your forms in a common directory.


Sub TallyData3()
Const adVarChar = 200
Const MaxCharacters = 255
Dim DataList As Object
Dim oPath As String
Dim FileArray() As String
Dim oFileName As String
Dim i As Long
Dim oTbl As Word.Table
Dim myDoc As Word.Document

oPath = GetPathToUse
If oPath = "" Then
MsgBox "A folder was not selected"
Exit Sub
End If
'Identify and count files
oFileName = Dir$(oPath & "*.doc")
ReDim FileArray(1 To 1000) 'A number larger the expected number of
replies
'Add file name to the array
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
'Add the data table with headings
ActiveDocument.Tables.Add Selection.Range, i + 1, 3
Set oTbl = ActiveDocument.Tables(1)
With oTbl
.Cell(1, 1).Range.Text = "Name"
.Cell(1, 2).Range.Text = "Favorite Food"
.Cell(1, 3).Range.Text = "Favorite Color"
End With
'Prepare the database
Set DataList = CreateObject("ADOR.Recordset")
DataList.Fields.Append "Name", adVarChar, MaxCharacters
DataList.Fields.Append "FavFood", adVarChar, MaxCharacters
DataList.Fields.Append "FavColor", adVarChar, MaxCharacters
DataList.Open
'Retrieve the data
For i = 1 To UBound(FileArray)
Set myDoc = Documents.Open(FileName:=oPath & FileArray(i), _
Visible:=False)

DataList.AddNew
With myDoc
DataList("Name") = .FormFields("Text1").Result
DataList("FavFood") = .FormFields("Text2").Result
DataList("FavColor") = .FormFields("Text3").Result
.Close
End With
DataList.Update
Next i
'Display the data
i = 1
DataList.MoveFirst
Do Until DataList.EOF
i = i + 1
oTbl.Cell(i, 1).Range.Text = DataList.Fields.Item("Name")
oTbl.Cell(i, 2).Range.Text = DataList.Fields.Item("FavFood")
oTbl.Cell(i, 3).Range.Text = DataList.Fields.Item("FavColor")
DataList.MoveNext
Loop
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

If you are able to adapt this so that it would simply record the
compiled data in a permant Access database or Excel spreadsheet then I
would appreciate seeing your results. Thanks.