I have written code that "prints" a report to Adobe and then gathers e-mail addresses, creates an e-mail, attaches the PDF and then sends it. The problem I seem to be running into is Access can't find the PDF because it is still in the process of being created. I need some way to pause the code until Adobe has finished creating the file. Below is the code.
Private Sub Command18_Click()
On Error GoTo Err_Command18_Click
Dim strEmail As String
Dim strBody As String
Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem
Dim stDocName As String
Dim stLinkCriteria As String
Dim stPrinter As String
Dim prt As Printer
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
If CheckComplete() = False Then
Exit Sub
End If
Me.HoldDate.Value = Now()
If (Me![sfrmProcedureRevision].Form![LastOfRevDate].Value) < 1 Or IsNull(Me![sfrmProcedureRevision].Form![LastOfRevDate].Value) = True Then
Me.Status.Value = "Hold"
Else
Me.Status.Value = "QT1"
End If
Me.Issued.Value = "Yes"
DoCmd.RunCommand acCmdSaveRecord
Set prt = Application.Printers("Adobe PDF")
prt.Orientation = acPRORLandscape
stDocName = "repAlert"
stLinkCriteria = "[WorkOrder]=" & Me![WorkOrder]
DoCmd.OpenReport stDocName, acPreview, , stLinkCriteria
Reports(stDocName).Printer = prt
DoCmd.PrintOut acPrintAll, , , acHigh
DoCmd.Close acReport, stDocName
strSQL = "SELECT tblEmail.Email FROM tblEmail WHERE ((tblEmail.LocationType = '" & [Forms]![frmAlertLog]![sfrmAlertLog].[Form]![Location] & "' Or tblEmail.LocationType = 'Warehouse') And (tblEmail.Plant = '" & [Forms]![frmAlertLog]![sfrmAlertLog].[Form]![MfgPlant] & "' Or tblEmail.Plant = 'Plymouth' Or tblEmail.Plant = 'All'));"
strEmail = ""
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
rs.MoveFirst
Do Until rs.EOF
If strEmail = "" Then
strEmail = rs!email
Else
strEmail = rs!email & ";" & strEmail
End If
rs.MoveNext
Loop
Set objOutlook = CreateObject("Outlook.application")
Set objEmail = objOutlook.CreateItem(olMailItem)
strBody = "The attached alert places parts on hold."
strBody = strBody & " " & Me.Initiator
With objEmail
.To = strEmail
.Subject = "Parts on Hold"
.Body = strBody
.FlagIcon = olRedFlagIcon
.Importance = olImportanceHigh
.Attachments.Add "G:\Plymouth Database\Quality Alert.pdf"
.Send
End With
Set objEmail = Nothing
Exit Sub
Me.Index.Requery
AlertLogSecurity
Exit_Command18_Click:
Exit Sub
Err_Command18_Click:
msgbox Err.Description
'msgbox "Either an error has occurred or the e-mail was canceled. If the e-mail was not canceled contact the system administrator."
Resume Exit_Command18_Click
End Sub
John Green
Private Sub Command18_Click()
On Error GoTo Err_Command18_Click
Dim strEmail As String
Dim strBody As String
Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem
Dim stDocName As String
Dim stLinkCriteria As String
Dim stPrinter As String
Dim prt As Printer
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
If CheckComplete() = False Then
Exit Sub
End If
Me.HoldDate.Value = Now()
If (Me![sfrmProcedureRevision].Form![LastOfRevDate].Value) < 1 Or IsNull(Me![sfrmProcedureRevision].Form![LastOfRevDate].Value) = True Then
Me.Status.Value = "Hold"
Else
Me.Status.Value = "QT1"
End If
Me.Issued.Value = "Yes"
DoCmd.RunCommand acCmdSaveRecord
Set prt = Application.Printers("Adobe PDF")
prt.Orientation = acPRORLandscape
stDocName = "repAlert"
stLinkCriteria = "[WorkOrder]=" & Me![WorkOrder]
DoCmd.OpenReport stDocName, acPreview, , stLinkCriteria
Reports(stDocName).Printer = prt
DoCmd.PrintOut acPrintAll, , , acHigh
DoCmd.Close acReport, stDocName
strSQL = "SELECT tblEmail.Email FROM tblEmail WHERE ((tblEmail.LocationType = '" & [Forms]![frmAlertLog]![sfrmAlertLog].[Form]![Location] & "' Or tblEmail.LocationType = 'Warehouse') And (tblEmail.Plant = '" & [Forms]![frmAlertLog]![sfrmAlertLog].[Form]![MfgPlant] & "' Or tblEmail.Plant = 'Plymouth' Or tblEmail.Plant = 'All'));"
strEmail = ""
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
rs.MoveFirst
Do Until rs.EOF
If strEmail = "" Then
strEmail = rs!email
Else
strEmail = rs!email & ";" & strEmail
End If
rs.MoveNext
Loop
Set objOutlook = CreateObject("Outlook.application")
Set objEmail = objOutlook.CreateItem(olMailItem)
strBody = "The attached alert places parts on hold."
strBody = strBody & " " & Me.Initiator
With objEmail
.To = strEmail
.Subject = "Parts on Hold"
.Body = strBody
.FlagIcon = olRedFlagIcon
.Importance = olImportanceHigh
.Attachments.Add "G:\Plymouth Database\Quality Alert.pdf"
.Send
End With
Set objEmail = Nothing
Exit Sub
Me.Index.Requery
AlertLogSecurity
Exit_Command18_Click:
Exit Sub
Err_Command18_Click:
msgbox Err.Description
'msgbox "Either an error has occurred or the e-mail was canceled. If the e-mail was not canceled contact the system administrator."
Resume Exit_Command18_Click
End Sub
John Green