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

  • Thread starter Thread starter Julie
  • Start date Start date
J

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
 
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
'============================
 
Back
Top