Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.word.mailmerge.fields
|
|||
|
|||
![]()
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 |
#2
![]()
Posted to microsoft.public.word.mailmerge.fields
|
|||
|
|||
![]()
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" wrote in message ... 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 |
#3
![]()
Posted to microsoft.public.word.mailmerge.fields
|
|||
|
|||
![]()
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 On Apr 7, 3:38*pm, "Doug Robbins - Word MVP" wrote: 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 read more »- Hide quoted text - - Show quoted text - |
Reply |
Thread Tools | |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
word opens access in mail merge. Access is already opened.=twice | Mailmerge | |||
Access Word Mail Merge help | Mailmerge | |||
Mail Merge using Word XP and Access XP | Mailmerge | |||
Mail merge from Access to Word | Mailmerge | |||
Word mail merge with Access | Mailmerge |