Module For Importing Word Forms

[darreninwarrington]

Morning all.

I'm after a little help on trying to automate a module used in an
Access project I have. The module simply imports data from a Word form
into a single table. The thing works fine but the code which I got from
the Microsoft MSDN library requires the user to enter the name of the
file they wish to import from (I've put the code at the end of this
message).

What I want to do is automate this somewhat and replace the code which
requests the file name with code that will simply import from every
word form that is in a given directory so that if there are 50 forms to
import, rather than run the module 50 times and typing in the filename
each time, the user simply runs the module once and it imports all 50
as 50 records in the table.

Any assistance or thoughts on this matter would be most appreciated.

D Hermes



The current module is as follows........

Sub GetWordData()
Dim appWord As Word.Application
Dim doc As Word.Document
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strDocName As String
Dim blnQuitWord As Boolean

On Error GoTo ErrorHandling

strDocName = "C:\Contracts\" & _
InputBox("Enter the name of the Word contract " & _
"you want to import:", "Import Contract")

Set appWord = GetObject(, "Word.Application")
Set doc = appWord.Documents.Open(strDocName)

cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\Contracts\" & _
"Healthcare Contracts.mdb;"
rst.Open "tblContracts", cnn, _
adOpenKeyset, adLockOptimistic

With rst
.AddNew
!FirstName = doc.FormFields("fldFirstName").Result
!LastName = doc.FormFields("fldLastName").Result
!Company = doc.FormFields("fldCompany").Result
!Address = doc.FormFields("fldAddress").Result
!City = doc.FormFields("fldCity").Result
!State = doc.FormFields("fldState").Result
!ZIP = doc.FormFields("fldZIP1").Result & _
"-" & doc.FormFields("fldZIP2").Result
!Phone = doc.FormFields("fldPhone").Result
!SocialSecurity = doc.FormFields("fldSocialSecurity").Result
!Gender = doc.FormFields("fldGender").Result
!BirthDate = doc.FormFields("fldBirthDate").Result
!AdditionalCoverage = _
doc.FormFields("fldAdditional").Result
.Update
.Close
End With
doc.Close
If blnQuitWord Then appWord.Quit
cnn.Close
MsgBox "Contract Imported!"


Cleanup:
Set rst = Nothing
Set cnn = Nothing
Set doc = Nothing
Set appWord = Nothing
Exit Sub
ErrorHandling:
Select Case Err
Case -2147022986, 429
Set appWord = CreateObject("Word.Application")
blnQuitWord = True
Resume Next
Case 5121, 5174
MsgBox "You must select a valid Word document. " _
& "No data imported.", vbOKOnly, _
"Document Not Found"
Case 5941
MsgBox "The document you selected does not " _
& "contain the required form fields. " _
& "No data imported.", vbOKOnly, _
"Fields Not Found"
Case Else
MsgBox Err & ": " & Err.Description
End Select
GoTo Cleanup
End Sub

 

[Douglas J. Steele]

Assuming all the documents you want to import are in C:\Contracts, and have
an extension of .Doc, the following code will return all of the files in
that folder:

Dim strFolder As String

strFolder = "C:\Contracts\"
strDocName = Dir$(strFolder & "*.doc")
Do While Len(strDocName) > 0

' Put the rest of the code to do the import here.
' You're importing strFolder & strDocName,
' not strDocName

strDocName = Dir$()
Loop

 

[Larry Daugherty]

There are many, many different ways you might achieve your objective.
Some are elegant and some are crude. What needs doing is determined
by the constraints of your environment. I won't even try to list all
of the things you must consider. It's just that when you automate you
need to get out the crystal ball and anticipate the unexpected. You
probably don't want the code to halt with an error prompt when
processing the first of 200 Word documents.

If I were doing it, I'd probably ask the user to navigate to the
target and select the first file. [I'd use the API code that replaces
the Common Dialog Controls that can be found at www.mvps.org/access
It takes a lot of wrestling with the code to get it going properly but
it's a worthwhile thing to do. Using the API means that that part of
your code will be bulletproof across versions of Access and across
OSs]. I'd then parse out the path and use the Dir successively to
return the next filename that matches the pattern. Eventually the Dir
command will return an empty string and you know you're done. You
need to change the code you're using now to have the record set open
throughout the whole operation of looping through the code that
retrieves the next file and gathers the info. Write the new record
and continue looping. When you fall out of the loop do the required
housekeeping. When you're doing something like that for the first
time you're wise to plan to get acquainted with the debugger to verify
that the right things are happening when you think they are..

I recommend that you design first using pseudopodia and that you work
with just one piece at a time. For example, if you've never played
with the Dir command as I've suggested above, write a small routine to
just loop through a folder willed with Word documents returning the
names. Debug.Print is a good friend!

Good luck with it. Post back as questions arise.

HTH

 

[darreninwarrington]

Hi Doug and many thanks for the information. I've added in the
suggested lines of code but now find that I get an error occurring when
running the module. It is one of the errors covered by the error
handling lines at the end of the code - the "You must select a valid
Word document. No data imported." error. The is despite the fact that
the C:\Contracts\ folder contains several valid Word documents, all of
which can be imported manually using the original code that requires
entering the filename.

Any ideas on what might be causing this error? Just in case I've caused
it by adding in your suggested lines in the wrong place, I've pasted
the revised code below.

Thanks once again. Darren.



Sub GetWordData()
Dim appWord As Word.Application
Dim doc As Word.Document
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strDocName As String
Dim blnQuitWord As Boolean
Dim strFolder As String

On Error GoTo ErrorHandling

strFolder = "C:\Contracts\"
strDocName = Dir$(strFolder & "*.doc")
Do While Len(strDocName) > 0

Set appWord = GetObject(, "Word.Application")
Set doc = appWord.Documents.Open(strDocName)

cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\Contracts\" & _
"Healthcare Contracts.mdb;"
rst.Open "tblContracts", cnn, _
adOpenKeyset, adLockOptimistic

With rst
.AddNew
!FirstName = doc.FormFields("fldFirstName").Result
!LastName = doc.FormFields("fldLastName").Result
!Company = doc.FormFields("fldCompany").Result
!Address = doc.FormFields("fldAddress").Result
!City = doc.FormFields("fldCity").Result
!State = doc.FormFields("fldState").Result
!ZIP = doc.FormFields("fldZIP1").Result & _
"-" & doc.FormFields("fldZIP2").Result
!Phone = doc.FormFields("fldPhone").Result
!SocialSecurity =
doc.FormFields("fldSocialSecurity").Result
!Gender = doc.FormFields("fldGender").Result
!BirthDate = doc.FormFields("fldBirthDate").Result
!AdditionalCoverage = _
doc.FormFields("fldAdditional").Result
.Update
.Close
End With
doc.Close
If blnQuitWord Then appWord.Quit
cnn.Close

strDocName = Dir$()
Loop

MsgBox "Contracts Imported!"


Cleanup:
Set rst = Nothing
Set cnn = Nothing
Set doc = Nothing
Set appWord = Nothing
Exit Function
ErrorHandling:
Select Case Err
Case -2147022986, 429
Set appWord = CreateObject("Word.Application")
blnQuitWord = True
Resume Next
Case 5121, 5174
MsgBox "You must select a valid Word document. " _
& "No data imported.", vbOKOnly, _
"Document Not Found"
Case 5941
MsgBox "The document you selected does not " _
& "contain the required form fields. " _
& "No data imported.", vbOKOnly, _
"Fields Not Found"
Case Else
MsgBox Err & ": " & Err.Description
End Select
GoTo Cleanup
End Sub

 

[Douglas J. Steele]

As I indicated in my code snippet, you need to refer to both strFolder and
strDocName when importing: strDocName does not contain folder information
when using Dir.

In other words, try changing

Set doc = appWord.Documents.Open(strDocName)

to

Set doc = appWord.Documents.Open(strFolder & strDocName)