S
snowiii
I ahve the below program which is supposed to import all *.doc files in a
particular diretory into a db. As it imports them it is supposed to mark the
files imported with a "xx" in front of the file name to signify not to import
it again. The problem I am having is that it does not run through all the
files in the directory...For instance I just ran it and it only imported 2 of
the 9 files...Any ideas on what I need to do to modify the code to make sure
all files are imported at once?
Thanks!
Here is the Code:
Private Sub GetWordData_Click()
'You need to add the path to 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.
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 strFileName As String
On Error GoTo ErrorHandling
Set appWord = GetObject(, "Word.Application")
'hard code the path and folder where the word forms are stored
strPath = "x:\Tom Snow\Temp" & "\"
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source= X:\Tom Snow\Coverage Verification Project\db folder\" & _
"Cart v2.mdb;"
rst.Open "InputTbl", cnn, _
adOpenKeyset, adLockOptimistic
Do While Left$(strFileName, 2) <> "xx"
strFileName = Dir(strPath & "*.doc")
Debug.Print strFileName
If Left$(strFileName, 2) = "xx" Then
'don't process
Else
Debug.Print strPath & strFileName
Set doc = appWord.Documents.Open(strPath & strFileName)
With rst
.AddNew
!RequestDate = doc.FormFields("RequestDate").Result
!Requestor = doc.FormFields("Requestor").Result
!CvgType = doc.FormFields("CvgType").Result
!Handler = doc.FormFields("Handler").Result
!HandlerPhone = doc.FormFields("HandlerPhone").Result
!Office = doc.FormFields("Office").Result
!Policy = doc.FormFields("Policy").Result
!EventNo = doc.FormFields("EventNo").Result
!Insured = doc.FormFields("Insured").Result
!DOL = doc.FormFields("DOL").Result
!VehicleYear = doc.FormFields("VehicleYear").Result
!VehicleMake = doc.FormFields("VehicleMake").Result
!VehicleModel = doc.FormFields("VehicleModel").Result
!VIN = doc.FormFields("VIN").Result
!ApproximateReserve = doc.FormFields("ApproximateReserve").Result
!Address = doc.FormFields("Address").Result
!LossLoc = doc.FormFields("LossLoc").Result
!DescriptionOfLoss = doc.FormFields("DescriptionOfLoss").Result
!UnverifiedStatus = doc.FormFields("UnverifiedStatus").Result
!InsuredPhone = doc.FormFields("InsuredPhone").Result
!InsuredState = doc.FormFields("InsuredState").Result
!InsuredZip = doc.FormFields("InsuredZip").Result
!Schedule = doc.FormFields("Schedule").Result
!BIX = doc.FormFields("Bix").Result
!IneligibleStatus = doc.FormFields("IneligibleStatus").Result
!CancelledStatus = doc.FormFields("CancelledStatus").Result
!PayLapseStatus = doc.FormFields("PayLapseStatus").Result
!MicrofilmStatus = doc.FormFields("MicrofilmStatus").Result
!VNOP = doc.FormFields("VNOP").Result
!VehiclePurchasedDate = doc.FormFields("VehiclePurchasedDate").Result
!CustomerNotifyDate = doc.FormFields("CustomerNotifyDate").Result
!CopyOfPolicy = doc.FormFields("CopyofPolicy").Result
!CopyOfApplication = doc.FormFields("CopyofApplication").Result
!UnderwritingFile = doc.FormFields("UnderwritingFile").Result
!Comments = doc.FormFields("Comments").Result
!CopyAppComments = doc.FormFields("CopyAppComments").Result
!WritingCo = doc.FormFields("WritingCo").Result
.Update
End With
doc.Close
Set doc = Nothing
Name strPath & strFileName As strPath & "xx" & strFileName
End If
Loop
rst.Close
If blnQuitWord Then appWord.Quit
cnn.Close
MsgBox "Inquiry 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
particular diretory into a db. As it imports them it is supposed to mark the
files imported with a "xx" in front of the file name to signify not to import
it again. The problem I am having is that it does not run through all the
files in the directory...For instance I just ran it and it only imported 2 of
the 9 files...Any ideas on what I need to do to modify the code to make sure
all files are imported at once?
Thanks!
Here is the Code:
Private Sub GetWordData_Click()
'You need to add the path to 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.
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 strFileName As String
On Error GoTo ErrorHandling
Set appWord = GetObject(, "Word.Application")
'hard code the path and folder where the word forms are stored
strPath = "x:\Tom Snow\Temp" & "\"
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source= X:\Tom Snow\Coverage Verification Project\db folder\" & _
"Cart v2.mdb;"
rst.Open "InputTbl", cnn, _
adOpenKeyset, adLockOptimistic
Do While Left$(strFileName, 2) <> "xx"
strFileName = Dir(strPath & "*.doc")
Debug.Print strFileName
If Left$(strFileName, 2) = "xx" Then
'don't process
Else
Debug.Print strPath & strFileName
Set doc = appWord.Documents.Open(strPath & strFileName)
With rst
.AddNew
!RequestDate = doc.FormFields("RequestDate").Result
!Requestor = doc.FormFields("Requestor").Result
!CvgType = doc.FormFields("CvgType").Result
!Handler = doc.FormFields("Handler").Result
!HandlerPhone = doc.FormFields("HandlerPhone").Result
!Office = doc.FormFields("Office").Result
!Policy = doc.FormFields("Policy").Result
!EventNo = doc.FormFields("EventNo").Result
!Insured = doc.FormFields("Insured").Result
!DOL = doc.FormFields("DOL").Result
!VehicleYear = doc.FormFields("VehicleYear").Result
!VehicleMake = doc.FormFields("VehicleMake").Result
!VehicleModel = doc.FormFields("VehicleModel").Result
!VIN = doc.FormFields("VIN").Result
!ApproximateReserve = doc.FormFields("ApproximateReserve").Result
!Address = doc.FormFields("Address").Result
!LossLoc = doc.FormFields("LossLoc").Result
!DescriptionOfLoss = doc.FormFields("DescriptionOfLoss").Result
!UnverifiedStatus = doc.FormFields("UnverifiedStatus").Result
!InsuredPhone = doc.FormFields("InsuredPhone").Result
!InsuredState = doc.FormFields("InsuredState").Result
!InsuredZip = doc.FormFields("InsuredZip").Result
!Schedule = doc.FormFields("Schedule").Result
!BIX = doc.FormFields("Bix").Result
!IneligibleStatus = doc.FormFields("IneligibleStatus").Result
!CancelledStatus = doc.FormFields("CancelledStatus").Result
!PayLapseStatus = doc.FormFields("PayLapseStatus").Result
!MicrofilmStatus = doc.FormFields("MicrofilmStatus").Result
!VNOP = doc.FormFields("VNOP").Result
!VehiclePurchasedDate = doc.FormFields("VehiclePurchasedDate").Result
!CustomerNotifyDate = doc.FormFields("CustomerNotifyDate").Result
!CopyOfPolicy = doc.FormFields("CopyofPolicy").Result
!CopyOfApplication = doc.FormFields("CopyofApplication").Result
!UnderwritingFile = doc.FormFields("UnderwritingFile").Result
!Comments = doc.FormFields("Comments").Result
!CopyAppComments = doc.FormFields("CopyAppComments").Result
!WritingCo = doc.FormFields("WritingCo").Result
.Update
End With
doc.Close
Set doc = Nothing
Name strPath & strFileName As strPath & "xx" & strFileName
End If
Loop
rst.Close
If blnQuitWord Then appWord.Quit
cnn.Close
MsgBox "Inquiry 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