Below is the full code I have come up with. I am having an issue when the error trap executes. Once the error is displayed it resumes to get the next file in the folder, but oDoc3 is somehow closed - I get an error indicating "Object has been deleted". This will work fine if I only use on file to update - oDoc2 stays open.
Code:
Sub BatchProcess()
Dim strFile As String
Dim strPath As String
Dim oDoc As Document
Dim strFile2 As String
Dim strPath2 As String
Dim oDoc2 As Document
Dim strFile3 As String
Dim strPath3 As String
Dim oDoc3 As Document
Dim fDialog As FileDialog
'Get document path for documents to be updated
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = "Select Folder To Be Processed"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Update Cancelled By User", , "List Folder Contents"
Exit Sub
End If
strPath = fDialog.SelectedItems.Item(1)
Do Until Right(strPath, 1) = "\"
strPath = strPath + "\"
Loop
End With
'Get document path for decision language document
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.Title = "Select File To Be Used As Decision Language Source"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Update Cancelled By User", , "List Folder Contents"
Exit Sub
End If
strPath2 = fDialog.SelectedItems.Item(1)
'Do Until Right(strPath2, 1) = "\"
' strPath2 = strPath2 + "\"
'Loop
End With
'Get document path for complaint language document
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.Title = "Select File To Be Used As Complaint Language Source"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Update Cancelled By User", , "List Folder Contents"
Exit Sub
End If
strPath3 = fDialog.SelectedItems.Item(1)
'Do Until Right(strPath2, 1) = "\"
' strPath2 = strPath2 + "\"
'Loop
End With
Set oDoc2 = Documents.Open(strPath2)
Set oDoc3 = Documents.Open(strPath3)
strFile = Dir$(strPath & "*.docx")
While strFile <> ""
Set oDoc = Documents.Open(strPath & strFile)
ICD10_Update oDoc, oDoc2, oDoc3
oDoc.Close SaveChanges:=wdSaveChanges
strFile = Dir$()
Wend
oDoc2.Close
oDoc3.Close
lbl_Exit:
Exit Sub
End Sub
Private Sub ICD10_Update(MainDoc As Document, DecisionsDoc As Document, ComplaintDoc As Document)
'table 3 = diagnosis
'table 4 = Medical Decision Making
'cell (2,3) = row 2, column 3
Dim strClean As String
Dim oTbl As Table
Dim Row As Integer
Dim Col As Integer
Dim strCellText As String
Dim ICD As String
Dim ICDLoc As String
Dim msg As String
Dim DecisionCount As Integer
Dim ComplaintCount As Integer
On Error Resume Next
Set oTbl = MainDoc.Tables(4)
If Err.Number = 5941 Then
msg = "Required table not found in " + MainDoc.Name
MsgBox msg, , "Document Error"
Exit Sub
End If
On Error GoTo 0
DecisionCount = 0
ComplaintCount = 0
For Row = 1 To (oTbl.Rows.Count - 1) 'Dont write in last row
For Col = 1 To oTbl.Columns.Count
strCellText = oTbl.Cell(Row, Col).Range.Text
strClean = Mid(strCellText, 1, Len(strCellText) - 2)
If UCase(Trim(strClean)) = "X" Then
ICD = oTbl.Cell(Row, 1).Range.Text
ICDLoc = oTbl.Cell(Row, 2).Range.Text
DecisionCount = DecisionCount + 1
If DecisionCount <= (oTbl.Rows.Count - 1) Then
Call UpdateDecision(Mid(ICD, 1, Len(ICD) - 2), Mid(ICDLoc, 1, Len(ICDLoc) - 2), MainDoc, DecisionsDoc, DecisionCount)
End If
ComplaintCount = ComplaintCount + 1
If ComplaintCount <= (oTbl.Rows.Count - 1) Then
Call UpdateComplaint(Mid(ICD, 1, Len(ICD) - 2), Mid(ICDLoc, 1, Len(ICDLoc) - 2), MainDoc, ComplaintDoc, ComplaintCount)
End If
Exit For
End If
Next
Next
End Sub
Private Sub UpdateDecision(inText1 As String, inText2 As String, MainDoc As Document, DecisionDoc As Document, DecisionCount As Integer)
Dim strClean As String
Dim oTbl2 As Table
Dim Row2 As Integer
Dim Col2 As Integer
Dim strCellText As String
Set oTbl2 = DecisionDoc.Tables(1)
For Row2 = 1 To oTbl2.Rows.Count
For Col2 = 1 To oTbl2.Columns.Count
strCellText = oTbl2.Cell(Row2, Col2).Range.Text
strClean = Mid(strCellText, 1, Len(strCellText) - 2)
If Trim(strClean) = inText1 Then
MainDoc.Tables(5).Cell(DecisionCount + 1, 2).Range.Text = strClean
strCellText = oTbl2.Cell(Row2, Col2 + 1).Range.Text
strClean = Mid(strCellText, 1, Len(strCellText) - 2)
MainDoc.Tables(5).Cell(DecisionCount + 1, 3).Range.Text = strClean
strCellText = oTbl2.Cell(Row2, Col2 + 2).Range.Text
strClean = Mid(strCellText, 1, Len(strCellText) - 2)
MainDoc.Tables(5).Cell(DecisionCount + 1, 4).Range.Text = strClean
End If
Next
Next
End Sub
Private Sub UpdateComplaint(inText1 As String, inText2 As String, MainDoc As Document, ComplaintDoc As Document, ComplaintCount As Integer)
Dim strClean As String
Dim oTbl2 As Table
Dim Row2 As Integer
Dim Col2 As Integer
Dim strCellText As String
Set oTbl2 = ComplaintDoc.Tables(1)
For Row2 = 1 To oTbl2.Rows.Count
For Col2 = 1 To oTbl2.Columns.Count
strCellText = oTbl2.Cell(Row2, Col2).Range.Text
strClean = Mid(strCellText, 1, Len(strCellText) - 2)
If Trim(strClean) = inText1 Then
MainDoc.Tables(2).Cell(ComplaintCount + 1, 2).Range.Text = strClean
strCellText = oTbl2.Cell(Row2, Col2 + 1).Range.Text
strClean = Mid(strCellText, 1, Len(strCellText) - 2)
MainDoc.Tables(2).Cell(ComplaintCount + 1, 3).Range.Text = strClean
strCellText = oTbl2.Cell(Row2, Col2 + 2).Range.Text
strClean = Mid(strCellText, 1, Len(strCellText) - 2)
MainDoc.Tables(2).Cell(ComplaintCount + 1, 4).Range.Text = strClean
End If
Next
Next
End Sub