Word Access Mail Merge getting an erro using mso.dll

R

Rodger

Hello,

I have an Access DB and am using word to print my reports. I have a
form where the user selects the Customer they want to print the
reports for and then I create a directory with the name of the
customer and then I create all the temp files that I may need. I then
open word using and get the appropriate template and then preform the
mail merge and save the new document in the folder I created. This
all work OK sometimes but I get and error sometimes.

The erro comes from word and it has to shut down due to an error. The
module is MSO.DLL I did a search for theis and mail merge but I did
not find very much. When I go back to Access I have an error that the
server through an exception and the line that it is on is this.

oApp.Close SaveChanges:=wdDoSaveChanges

Here is all the code the first half is just creating the temp files.

Private Sub myReports(myView, myCountA)

'On Error GoTo Err_myReports

Dim ReportPath, myReturn
Dim oApp As Object, myDocName, X, myDB, myDataSource, myTemplatePath,
myTemplateName
Dim dbsCurrent As Database, dbsPath As String
Dim myMessage, myStyle, myTitle, myResponse
Dim myQRY7, myQRYRealEstateAppraisal, myQRY1244_Step1,
myQRY1244_Step2, myQRY1244B_Step1
Dim myQRYTrackingSheet, myQRY_TEMP_OWNER_GUARANTOR
Dim myID, my1244Count, myReserveAmount, myRS
Dim myFolderName, myDocumnetPath, myDirectoryExists


myDocumentPath = "R:\SBA Documents"

myReturn:
If myCountA <= 1 Then

Set myDB = CurrentDb()

myID = [Forms]![frm_Reports_New]![cmbLoan]

myReserveAmount = 0


mySQL = "SELECT VARIABLES.*, VARIABLES.VAR_IMP_ID FROM VARIABLES WHERE
(((VARIABLES.VAR_IMP_ID)=" & myID & "));"

Set myRS = myDB.OpenRecordset(mySQL)
If myRS.EOF Then
myMessage = "Please enter default variables for this loan"
myTitle = "Default Values are empty"
myStyle = vbCritical + vbOKOnly
myResponse = MsgBox(myMessage, myStyle, myTitle)
Exit Sub
Else
myReserveAmount = myRS![VAR_RESERVE_AMOUNT]
End If




If IsNull(Me.cmbLoan) Then
myMessage = "Please select a loan"
myTitle = "No Selection"
myStyle = vbCritical + vbOKOnly
myResponse = MsgBox(myMessage, myStyle, myTitle)
Exit Sub
Else
DoCmd.SetWarnings False
'*************************************************************
'*** ***
'*** Create Directory Structure for the Word Documents ***
'*** DATE: 02/23/2008 ***
'*** ***
'*************************************************************


'Get the SBA Name
myFolderName = Me.cmbLoan.Column(1)
'Remove any special characters and replce with an
'underscore _ also change to uppercase
myFolderName = Replace(myFolderName, ",", "")
myFolderName = Replace(myFolderName, ".", "")
myFolderName = Replace(myFolderName, "&", "")
myFolderName = Replace(myFolderName, "-", "_")
myFolderName = Replace(myFolderName, " ", " ")
myFolderName = Replace(myFolderName, " ", "_")
myFolderName = UCase(myFolderName)

'Determine if it exists
If Dir(myDocumentPath & "\" & myFolderName, vbDirectory) = "" Then
MkDir myDocumentPath & "\" & myFolderName
End If

'CREATE TEMP TABLES
'Form the SBA and EPC Gauantor table to merge them
Call updateTEMP_OWNERS

'DELETE TEMP TABLES
If DoesObjectExist("Tables", "tmp_RealEstateAppraisal") = 0 Then
Else
DoCmd.DeleteObject acTable, "tmp_RealEstateAppraisal"
End If

If DoesObjectExist("Tables", "tmp_Submission") = 0 Then
Else
DoCmd.DeleteObject acTable, "tmp_Submission"
End If

If DoesObjectExist("Tables", "tmp_CheckLists") = 0 Then
Else
DoCmd.DeleteObject acTable, "tmp_CheckLists"
End If

If DoesObjectExist("Tables", "tmp_Environmental") = 0 Then
Else
DoCmd.DeleteObject acTable, "tmp_Environmental"
End If

'REAL ESTATE APPRAISAL
myQRYRealEstateAppraisal = "SELECT IMPORT.IMP_ID,
IMPORT.IMP_BOR_NAME, IMPORT.IMP_BOR_PROJECT_ADDRESS,
IMPORT.IMP_BOR_PROJECT_ADDRESS2, IMPORT.IMP_BOR_PROJECT_CITY,
IMPORT.IMP_BOR_PROJECT_STATE, IMPORT.IMP_BOR_PROJECT_ZIP,
IMPORT.IMP_BOR_PRINCIPAL, IMPORT.IMP_BOR_SBC, IMPORT.IMP_BOR_DBA,
IMPORT.IMP_BOR_EMAIL, SETUP.SET_COMPANY_NAME, SETUP.SET_COMPANY_OWNER,
SETUP.SET_ADDRESS, SETUP.SET_CITY, SETUP.SET_STATE, SETUP.SET_ZIP,
SETUP.SET_PHONE, SETUP.SET_FAX, SETUP.SET_EMAIL1 " & _
"FROM IMPORT, SETUP " & _
"WHERE IMPORT.IMP_ID= " & myID

'myDB.Execute (myQRYRealEstateAppraisal)
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath & "\" &
myFolderName & "\tmp_RealEstateAppraisal.csv"
DoCmd.TransferText acExportDelim, ,
"qry_RealEstateAppraisal_Export1", myDocumentPath & "\" & myFolderName
& "\tmp_RealEstateAppraisal.csv", True

'1244
'DoCmd.OpenQuery "qry_1244_Step2"
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath & "\" &
myFolderName & "\tmp_1244.csv"
DoCmd.TransferText acExportDelim, , "qry_1244_Step2_Export",
myDocumentPath & "\" & myFolderName & "\tmp_1244.csv", True

'TRACKING SHEET
'DoCmd.OpenQuery "qry_TrackingSheet"
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath & "\" &
myFolderName & "\tmp_1244.csv"
DoCmd.TransferText acExportDelim, , "qry_TrackingSheet_Export",
myDocumentPath & "\" & myFolderName & "\tmp_TrackingSheet.csv", True

'TEMP OWNER GUARANTOR
'DoCmd.OpenQuery "qry_TEMP_OWNER_GUARANTOR"
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath & "\" &
myFolderName & "\tmp_1244.csv"
DoCmd.TransferText acExportDelim, ,
"qry_TEMP_OWNER_GUARANTOR_Export", myDocumentPath & "\" & myFolderName
& "\TEMP1.csv", True

'EXHIBIT 1
'DoCmd.OpenQuery "qry_Exhibit_1"
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath & "\" &
myFolderName & "\tmp_Exhibit1.csv"
DoCmd.TransferText acExportDelim, , "qry_Exhibit_1_Export",
myDocumentPath & "\" & myFolderName & "\tmp_Exhibit1.csv", True

'1244B
'DoCmd.OpenQuery "qry_1244B_Step1"
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath & "\" &
myFolderName & "\tmp_1244B.csv"
DoCmd.TransferText acExportDelim, , "qry_1244B_Step1_Export",
myDocumentPath & "\" & myFolderName & "\tmp_1244B.csv", True

'1244_4
'DoCmd.OpenQuery "qry_1244_4_Step2"
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath & "\" &
myFolderName & "\tmp_1244_4.csv"
DoCmd.TransferText acExportDelim, , "qry_1244_4_Step2_Export",
myDocumentPath & "\" & myFolderName & "\tmp_1244_4.csv", True

'SUBMISSION
'DoCmd.OpenQuery "qry_Submission_Step2"
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath & "\" &
myFolderName & "\tmp_Submission.csv"
DoCmd.TransferText acExportDelim, , "qry_Submission_Step2_Export",
myDocumentPath & "\" & myFolderName & "\tmp_Submission.csv", True

'CHECKLIST
'DoCmd.OpenQuery "qry_CheckLists_Step2"
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath & "\" &
myFolderName & "\tmp_CheckLists.csv"
DoCmd.TransferText acExportDelim, , "qry_CheckLists_Step2_Export",
myDocumentPath & "\" & myFolderName & "\tmp_CheckLists.csv", True

'ENVIRONMENTAL
'DoCmd.OpenQuery "qry_Environmental_Step2"
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath & "\" &
myFolderName & "\tmp_Environmental.csv"
DoCmd.TransferText acExportDelim, ,
"qry_Environmental_Step2_Export", myDocumentPath & "\" & myFolderName
& "\tmp_Environmental.csv", True

'SUPPLEMENT
my1244Count = DCount("EPC", "tmp_1244")
If my1244Count <= 0 Then
Else
'DoCmd.OpenQuery "qry_Supplement_Step2"
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath &
"\" & myFolderName & "\tmp_Supplemental.csv"
DoCmd.TransferText acExportDelim, ,
"qry_Supplement_Step2_Export", myDocumentPath & "\" & myFolderName &
"\tmp_Supplemental.csv", True
End If

'REAL ESTATE APPRAISAL
'DoCmd.OpenQuery "qry_RealEstateAppraisal"
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath & "\" &
myFolderName & "\tmp_RealEstateAppraisa.csv"
DoCmd.TransferText acExportDelim, ,
"qry_RealEstateAppraisal_Export", myDocumentPath & "\" & myFolderName
& "\tmp_RealEstateAppraisal.csv", True

DoCmd.SetWarnings True

'CREATE WORD DOCUMENTS

myTemplatePath = "R:\Application Templates"
'Stop
'504 CDC Checklist for Submitting loan
If Me.ckbEnvironmental = -1 Then
myDocName = myDocumentPath & "\" & myFolderName & "\504 CDC
Checklist for Submitting loan.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_CheckLists.csv"
myTemplateName = myTemplatePath & "\504 CDC Checklist for
Submitting loan.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing
End If

'504 CDC Checklist for Submitting Environmental Investigation
If Me.ckbEnvironmental = -1 Then
myDocName = myDocumentPath & "\" & myFolderName & "\504 CDC
Checklist for Submitting Environmental Investigation.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_Environmental.csv"
myTemplateName = myTemplatePath & "\504 CDC Checklist for
Submitting Environmental Investigation.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing
End If

'504 CDC Checklist for Submitting Equipment Appraisal
If Me.ckbAppraisalME = -1 Then
myDocName = myDocumentPath & "\" & myFolderName & "\504 CDC
Checklist for Submitting Equipment Appraisal.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_Environmental.csv"
myTemplateName = myTemplatePath & "\504 CDC Checklist for
Submitting Equipment Appraisal.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing
End If

'504 CDC Checklist for Submitting Real Estate Appraisal
If Me.ckbAppraisalRE = -1 Then
myDocName = myDocumentPath & "\" & myFolderName & "\504 CDC
Checklist for Submitting Real Estate Appraisal.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_RealEstateAppraisal.csv"
myTemplateName = myTemplatePath & "\504 CDC Checklist for
Submitting Real Estate Appraisal.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing
End If

'Exhibit 1
If Me.ckbExhibit1 = -1 Then
myDocName = myDocumentPath & "\" & myFolderName & "\Exhibit 1.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_Exhibit1.csv"
myTemplateName = myTemplatePath & "\Exhibit 1.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing
End If

'Tracking_Sheet
If Me.ckbTrackingSheet = -1 Then
myDocName = myDocumentPath & "\" & myFolderName &
"\Tracking_Sheet.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_TrackingSheet.csv"
myTemplateName = myTemplatePath & "\Tracking_Sheet.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing
End If

'504 Supplemental
If Me.ckbSupplemental = -1 Then
myDocName = myDocumentPath & "\" & myFolderName & "\504
Supplemental.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_Supplemental.csv"
myTemplateName = myTemplatePath & "\504 Supplemental.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing
End If

'1244 Documents
If Me.ckb1244 = -1 Then
'1244
myDocName = myDocumentPath & "\" & myFolderName & "\1244.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_1244.csv"
myTemplateName = myTemplatePath & "\1244.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing

'1244B
myDocName = myDocumentPath & "\" & myFolderName & "\1244B.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_1244B.csv"
myTemplateName = myTemplatePath & "\1244B.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing


'1244C
myDocName = myDocumentPath & "\" & myFolderName & "\1244C.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_1244_4.csv"
myTemplateName = myTemplatePath & "\1244C.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing
End If

'504 Eligibility ChecklistA
If Me.ckbEligibility1 = -1 Then
myDocName = myDocumentPath & "\" & myFolderName & "\504
Eligibility ChecklistA.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_Submission.csv"
myTemplateName = myTemplatePath & "\504 Eligibility
ChecklistA.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing
End If

'Board Approval
If Me.ckbMemo = -1 Then
myDocName = myDocumentPath & "\" & myFolderName &
"\BoardApproval.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_Exhibit1.csv"
myTemplateName = myTemplatePath & "\BoardApproval.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing
End If




Exit Sub

Thank you,
Rodger
 
D

Doug Robbins - Word MVP

It should be

oApp.Close SaveChanges:=wdSaveChanges

or

oApp.Close SaveChanges:=wdDoNotSaveChanges

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

Rodger said:
Hello,

I have an Access DB and am using word to print my reports. I have a
form where the user selects the Customer they want to print the
reports for and then I create a directory with the name of the
customer and then I create all the temp files that I may need. I then
open word using and get the appropriate template and then preform the
mail merge and save the new document in the folder I created. This
all work OK sometimes but I get and error sometimes.

The erro comes from word and it has to shut down due to an error. The
module is MSO.DLL I did a search for theis and mail merge but I did
not find very much. When I go back to Access I have an error that the
server through an exception and the line that it is on is this.

oApp.Close SaveChanges:=wdDoSaveChanges

Here is all the code the first half is just creating the temp files.

Private Sub myReports(myView, myCountA)

'On Error GoTo Err_myReports

Dim ReportPath, myReturn
Dim oApp As Object, myDocName, X, myDB, myDataSource, myTemplatePath,
myTemplateName
Dim dbsCurrent As Database, dbsPath As String
Dim myMessage, myStyle, myTitle, myResponse
Dim myQRY7, myQRYRealEstateAppraisal, myQRY1244_Step1,
myQRY1244_Step2, myQRY1244B_Step1
Dim myQRYTrackingSheet, myQRY_TEMP_OWNER_GUARANTOR
Dim myID, my1244Count, myReserveAmount, myRS
Dim myFolderName, myDocumnetPath, myDirectoryExists


myDocumentPath = "R:\SBA Documents"

myReturn:
If myCountA <= 1 Then

Set myDB = CurrentDb()

myID = [Forms]![frm_Reports_New]![cmbLoan]

myReserveAmount = 0


mySQL = "SELECT VARIABLES.*, VARIABLES.VAR_IMP_ID FROM VARIABLES WHERE
(((VARIABLES.VAR_IMP_ID)=" & myID & "));"

Set myRS = myDB.OpenRecordset(mySQL)
If myRS.EOF Then
myMessage = "Please enter default variables for this loan"
myTitle = "Default Values are empty"
myStyle = vbCritical + vbOKOnly
myResponse = MsgBox(myMessage, myStyle, myTitle)
Exit Sub
Else
myReserveAmount = myRS![VAR_RESERVE_AMOUNT]
End If




If IsNull(Me.cmbLoan) Then
myMessage = "Please select a loan"
myTitle = "No Selection"
myStyle = vbCritical + vbOKOnly
myResponse = MsgBox(myMessage, myStyle, myTitle)
Exit Sub
Else
DoCmd.SetWarnings False
'*************************************************************
'*** ***
'*** Create Directory Structure for the Word Documents ***
'*** DATE: 02/23/2008 ***
'*** ***
'*************************************************************


'Get the SBA Name
myFolderName = Me.cmbLoan.Column(1)
'Remove any special characters and replce with an
'underscore _ also change to uppercase
myFolderName = Replace(myFolderName, ",", "")
myFolderName = Replace(myFolderName, ".", "")
myFolderName = Replace(myFolderName, "&", "")
myFolderName = Replace(myFolderName, "-", "_")
myFolderName = Replace(myFolderName, " ", " ")
myFolderName = Replace(myFolderName, " ", "_")
myFolderName = UCase(myFolderName)

'Determine if it exists
If Dir(myDocumentPath & "\" & myFolderName, vbDirectory) = "" Then
MkDir myDocumentPath & "\" & myFolderName
End If

'CREATE TEMP TABLES
'Form the SBA and EPC Gauantor table to merge them
Call updateTEMP_OWNERS

'DELETE TEMP TABLES
If DoesObjectExist("Tables", "tmp_RealEstateAppraisal") = 0 Then
Else
DoCmd.DeleteObject acTable, "tmp_RealEstateAppraisal"
End If

If DoesObjectExist("Tables", "tmp_Submission") = 0 Then
Else
DoCmd.DeleteObject acTable, "tmp_Submission"
End If

If DoesObjectExist("Tables", "tmp_CheckLists") = 0 Then
Else
DoCmd.DeleteObject acTable, "tmp_CheckLists"
End If

If DoesObjectExist("Tables", "tmp_Environmental") = 0 Then
Else
DoCmd.DeleteObject acTable, "tmp_Environmental"
End If

'REAL ESTATE APPRAISAL
myQRYRealEstateAppraisal = "SELECT IMPORT.IMP_ID,
IMPORT.IMP_BOR_NAME, IMPORT.IMP_BOR_PROJECT_ADDRESS,
IMPORT.IMP_BOR_PROJECT_ADDRESS2, IMPORT.IMP_BOR_PROJECT_CITY,
IMPORT.IMP_BOR_PROJECT_STATE, IMPORT.IMP_BOR_PROJECT_ZIP,
IMPORT.IMP_BOR_PRINCIPAL, IMPORT.IMP_BOR_SBC, IMPORT.IMP_BOR_DBA,
IMPORT.IMP_BOR_EMAIL, SETUP.SET_COMPANY_NAME, SETUP.SET_COMPANY_OWNER,
SETUP.SET_ADDRESS, SETUP.SET_CITY, SETUP.SET_STATE, SETUP.SET_ZIP,
SETUP.SET_PHONE, SETUP.SET_FAX, SETUP.SET_EMAIL1 " & _
"FROM IMPORT, SETUP " & _
"WHERE IMPORT.IMP_ID= " & myID

'myDB.Execute (myQRYRealEstateAppraisal)
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath & "\" &
myFolderName & "\tmp_RealEstateAppraisal.csv"
DoCmd.TransferText acExportDelim, ,
"qry_RealEstateAppraisal_Export1", myDocumentPath & "\" & myFolderName
& "\tmp_RealEstateAppraisal.csv", True

'1244
'DoCmd.OpenQuery "qry_1244_Step2"
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath & "\" &
myFolderName & "\tmp_1244.csv"
DoCmd.TransferText acExportDelim, , "qry_1244_Step2_Export",
myDocumentPath & "\" & myFolderName & "\tmp_1244.csv", True

'TRACKING SHEET
'DoCmd.OpenQuery "qry_TrackingSheet"
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath & "\" &
myFolderName & "\tmp_1244.csv"
DoCmd.TransferText acExportDelim, , "qry_TrackingSheet_Export",
myDocumentPath & "\" & myFolderName & "\tmp_TrackingSheet.csv", True

'TEMP OWNER GUARANTOR
'DoCmd.OpenQuery "qry_TEMP_OWNER_GUARANTOR"
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath & "\" &
myFolderName & "\tmp_1244.csv"
DoCmd.TransferText acExportDelim, ,
"qry_TEMP_OWNER_GUARANTOR_Export", myDocumentPath & "\" & myFolderName
& "\TEMP1.csv", True

'EXHIBIT 1
'DoCmd.OpenQuery "qry_Exhibit_1"
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath & "\" &
myFolderName & "\tmp_Exhibit1.csv"
DoCmd.TransferText acExportDelim, , "qry_Exhibit_1_Export",
myDocumentPath & "\" & myFolderName & "\tmp_Exhibit1.csv", True

'1244B
'DoCmd.OpenQuery "qry_1244B_Step1"
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath & "\" &
myFolderName & "\tmp_1244B.csv"
DoCmd.TransferText acExportDelim, , "qry_1244B_Step1_Export",
myDocumentPath & "\" & myFolderName & "\tmp_1244B.csv", True

'1244_4
'DoCmd.OpenQuery "qry_1244_4_Step2"
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath & "\" &
myFolderName & "\tmp_1244_4.csv"
DoCmd.TransferText acExportDelim, , "qry_1244_4_Step2_Export",
myDocumentPath & "\" & myFolderName & "\tmp_1244_4.csv", True

'SUBMISSION
'DoCmd.OpenQuery "qry_Submission_Step2"
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath & "\" &
myFolderName & "\tmp_Submission.csv"
DoCmd.TransferText acExportDelim, , "qry_Submission_Step2_Export",
myDocumentPath & "\" & myFolderName & "\tmp_Submission.csv", True

'CHECKLIST
'DoCmd.OpenQuery "qry_CheckLists_Step2"
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath & "\" &
myFolderName & "\tmp_CheckLists.csv"
DoCmd.TransferText acExportDelim, , "qry_CheckLists_Step2_Export",
myDocumentPath & "\" & myFolderName & "\tmp_CheckLists.csv", True

'ENVIRONMENTAL
'DoCmd.OpenQuery "qry_Environmental_Step2"
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath & "\" &
myFolderName & "\tmp_Environmental.csv"
DoCmd.TransferText acExportDelim, ,
"qry_Environmental_Step2_Export", myDocumentPath & "\" & myFolderName
& "\tmp_Environmental.csv", True

'SUPPLEMENT
my1244Count = DCount("EPC", "tmp_1244")
If my1244Count <= 0 Then
Else
'DoCmd.OpenQuery "qry_Supplement_Step2"
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath &
"\" & myFolderName & "\tmp_Supplemental.csv"
DoCmd.TransferText acExportDelim, ,
"qry_Supplement_Step2_Export", myDocumentPath & "\" & myFolderName &
"\tmp_Supplemental.csv", True
End If

'REAL ESTATE APPRAISAL
'DoCmd.OpenQuery "qry_RealEstateAppraisal"
DoCmd.Echo True, "Creating TEMP TABLE " & myDocumentPath & "\" &
myFolderName & "\tmp_RealEstateAppraisa.csv"
DoCmd.TransferText acExportDelim, ,
"qry_RealEstateAppraisal_Export", myDocumentPath & "\" & myFolderName
& "\tmp_RealEstateAppraisal.csv", True

DoCmd.SetWarnings True

'CREATE WORD DOCUMENTS

myTemplatePath = "R:\Application Templates"
'Stop
'504 CDC Checklist for Submitting loan
If Me.ckbEnvironmental = -1 Then
myDocName = myDocumentPath & "\" & myFolderName & "\504 CDC
Checklist for Submitting loan.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_CheckLists.csv"
myTemplateName = myTemplatePath & "\504 CDC Checklist for
Submitting loan.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing
End If

'504 CDC Checklist for Submitting Environmental Investigation
If Me.ckbEnvironmental = -1 Then
myDocName = myDocumentPath & "\" & myFolderName & "\504 CDC
Checklist for Submitting Environmental Investigation.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_Environmental.csv"
myTemplateName = myTemplatePath & "\504 CDC Checklist for
Submitting Environmental Investigation.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing
End If

'504 CDC Checklist for Submitting Equipment Appraisal
If Me.ckbAppraisalME = -1 Then
myDocName = myDocumentPath & "\" & myFolderName & "\504 CDC
Checklist for Submitting Equipment Appraisal.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_Environmental.csv"
myTemplateName = myTemplatePath & "\504 CDC Checklist for
Submitting Equipment Appraisal.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing
End If

'504 CDC Checklist for Submitting Real Estate Appraisal
If Me.ckbAppraisalRE = -1 Then
myDocName = myDocumentPath & "\" & myFolderName & "\504 CDC
Checklist for Submitting Real Estate Appraisal.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_RealEstateAppraisal.csv"
myTemplateName = myTemplatePath & "\504 CDC Checklist for
Submitting Real Estate Appraisal.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing
End If

'Exhibit 1
If Me.ckbExhibit1 = -1 Then
myDocName = myDocumentPath & "\" & myFolderName & "\Exhibit 1.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_Exhibit1.csv"
myTemplateName = myTemplatePath & "\Exhibit 1.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing
End If

'Tracking_Sheet
If Me.ckbTrackingSheet = -1 Then
myDocName = myDocumentPath & "\" & myFolderName &
"\Tracking_Sheet.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_TrackingSheet.csv"
myTemplateName = myTemplatePath & "\Tracking_Sheet.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing
End If

'504 Supplemental
If Me.ckbSupplemental = -1 Then
myDocName = myDocumentPath & "\" & myFolderName & "\504
Supplemental.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_Supplemental.csv"
myTemplateName = myTemplatePath & "\504 Supplemental.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing
End If

'1244 Documents
If Me.ckb1244 = -1 Then
'1244
myDocName = myDocumentPath & "\" & myFolderName & "\1244.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_1244.csv"
myTemplateName = myTemplatePath & "\1244.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing

'1244B
myDocName = myDocumentPath & "\" & myFolderName & "\1244B.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_1244B.csv"
myTemplateName = myTemplatePath & "\1244B.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing


'1244C
myDocName = myDocumentPath & "\" & myFolderName & "\1244C.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_1244_4.csv"
myTemplateName = myTemplatePath & "\1244C.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing
End If

'504 Eligibility ChecklistA
If Me.ckbEligibility1 = -1 Then
myDocName = myDocumentPath & "\" & myFolderName & "\504
Eligibility ChecklistA.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_Submission.csv"
myTemplateName = myTemplatePath & "\504 Eligibility
ChecklistA.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing
End If

'Board Approval
If Me.ckbMemo = -1 Then
myDocName = myDocumentPath & "\" & myFolderName &
"\BoardApproval.doc"
myDataSource = myDocumentPath & "\" & myFolderName &
"\tmp_Exhibit1.csv"
myTemplateName = myTemplatePath & "\BoardApproval.dot"

Set oApp = GetObject(myTemplateName, "Word.Document")
'oApp.Application.Visible = True
oApp.MailMerge.OpenDataSource Name:=myDataSource,
LinktoSource:=True, AddToRecentFiles:=False
oApp.MailMerge.Destination = wdSendToNewDocument
oApp.MailMerge.SuppressBlankLines = True
oApp.MailMerge.Execute

oApp.Application.Documents(1).SaveAs (myDocName)

If myView = 2 Then
oApp.Application.Visible = True
oApp.Close SaveChanges:=wdDoSaveChanges
Else
oApp.Application.ActiveDocument.PrintOut
oApp.Application.Documents(1).Close
End If

Set oApp = Nothing
End If




Exit Sub

Thank you,
Rodger
Click to expand...
 
R

Rodger

Doug,

Thank you! That seemed to help the code to work; however now when I
close the word document I am getting the following error form
Windows.

Microsoft Word has encountered a problem and needs to close. We are
sorry for the inconvenience.

Error Signature
AppName: winword.exe AppVer: 10.0.2627.0
ModName: mso.dll
ModVer: 10.0.2626.0 Offset: 0004adba



OS: Windows 2003 R2
Office: XP Pro


Thanks again,
Rodger
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Mail Merge HELP 3

Top