How can I import from many Word Forms into one Excel Spreadsheet

[Julie]

What I ultimately need to do is take information from
100's of Word forms (completed electronically), and
compile it all in to one Excel database.

I have tried to save the MS Word form (.dot) to a .txt
file and then open the .txt file in Excel. I have also
tried to do a query to import the .txt file, but I don't
know to compile from many different forms into one
database. I am running in circles trying to use the help
files included with the software. Can anyone help?

Very grateful.

Julie

 

[Debra Dalgleish]

1. Save all the completed Word forms as text (in Word, choose
Tools>Options, and on the Save tab, add a check mark to
'Save data only for forms')
2. Place all the files in one folder ("c:\TestFiles\" in this example)
3. Open the Excel file in which you want to collect the data
("MyImports.xls" in this example, on sheet "FormData")
4. Run a macro similar to the following, which loops through all the
files in the designated folder, and copies the form data to the
master file

'============================
Sub ImportTextFiles()
'code for looping through file in folder
'stolen from post by Dave Peterson
Dim myFiles() As String
Dim i As Integer
Dim myFile As String
Dim myFolder As String
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
Dim r As Long
'this sheet collects the form data
Set ws = Workbooks("MyImports.xls").Sheets("FormData")

Application.DisplayAlerts = False
Application.ScreenUpdating = False

myFolder = "c:\TestFiles\"
If Right(myFolder, 1) <> "\" Then
myFolder = myFolder & "\"
End If

myFile = Dir(myFolder & "*.txt")

If myFile = "" Then
MsgBox "no text files found"
Exit Sub
End If

Do While myFile <> ""
i = i + 1
ReDim Preserve myFiles(1 To i)
myFiles(i) = myFile
myFile = Dir()
Loop

For i = LBound(myFiles) To UBound(myFiles)
r = ws.Range("A1").End(xlDown).Offset(1, 0).Row
Set rng = ws.Range("A" & r)
Workbooks.OpenText Filename:=myFolder & myFiles(i), _
Origin:=437, StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=True, Semicolon:=False, Comma:=False, Space:=False, _
Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1))
Set wb = ActiveWorkbook
ActiveSheet.Rows("1:1").Copy Destination:=rng
wb.Close savechanges:=False
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
'============================