Here is some code that will loop through a folder and then process the word
doc with your code.
I haven't had time to set up some docs and test it, you may need to debug it
..
You need to add the path of the docs you want to process - this is hard
coded where you see strPath = "C:\....."
The process imports the first word doc, renames the doc with xx in front of
the doc name and then does the next doc.
You will end up with every word doc renamed with xx in front of the file
name.
This code assumes that only word docs are stored in the folder.
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 blnQuitWord As Boolean
Dim strPath As String
Dim strSourceFolder As String
Dim strFileName As String
On Error GoTo ErrorHandling
'hard code the path and folder where the word forms are stored
strPath = "C:\....."
strSourceFolder = strPath & "\"
strFileName = Dir(strSourceFolder)
Set appWord = GetObject(, "Word.Application")
Do While Left$(strFileName, 2) <> "xx"
strFileName = Dir(strSourceFolder)
If Left$(strFileName, 2) = "xx" Then
'don't process
Else
'Debug.Print strFileName
Set doc = appWord.Documents.Open(strFileName)
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\My Documents\" & _
"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
Name strSourceFolder & strFileName As strSourceFolder & "xx" &
strFileName
End If
Loop
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
Jeanette Cunningham
