Public Function SendEmailEmpCompletedRptNoErrorsNoAction(ByVal varEmpEmail, varAddlEmail As String) On Error GoTo Err_handler Dim objOutlook As Object Dim objOutlookMsg As Object Dim objOutlookRecip As Object Dim objOutlookAttach As Object Dim AttachmentPath As String Dim DisplayMsg As String Dim strAttach1 As String Dim strAttachTemp As String Dim strOutputToTemp As String Dim strAttachCopy As String Dim strPTR As Printer DoCmd.Echo False DoCmd.SetWarnings False ' check to see if folder c:\users exists on user's hard drive, if not, create If Len(Dir("C:\Users", vbDirectory)) = 0 Then MkDir "C:\Users" End If strOutputToTemp = "C:\Users\Audit_Completed" & "_" & InquiryNum & ".PDF" '''Output to Temp Area (to C:\Users) DoCmd.OutputTo acOutputReport, "rptAudit_Emails_EMP_NoErrorsNoAction", acFormatPDF, strOutputToTemp, False 'Set Attachments (from Temp Dir on C Drive) strAttachTemp = strOutputToTemp ' Copy to Network 'strAttachCopy = "\\Wiw2pwpfle001\data\QA Database\Employee Audit Scorecard System\Audit_Completed\Audit_Completed" & "_" & InquiryNum & ".PDF" 'OLD PATH -- NOT WORKING as of 7-15-2014 strAttachCopy = "\\w2pwpfp001\data\QA Database\Employee Audit Scorecard System\Audit_Completed\Audit_Completed" & "_" & InquiryNum & ".PDF" ' Variable/Path (to copy from C: Drive to Network Drive Folder for Completed Audits FileCopy strAttachTemp, strAttachCopy ' Create the Outlook session. Set objOutlook = CreateObject("Outlook.Application") ' Create the message. Set objOutlookMsg = objOutlook.CreateItem(olMailItem) 'Create the email message and send 'Set objMessage = objOutlook.CreateItem(olMailItem) With objOutlookMsg .To = varEmpEmail & "; " & "email@example.com" ' .CC = varAddlEmail ' Set the Subject, Body, and Importance of the message. .Subject = "Audit Completed With No Errors -- No Action Required as of " & Now() & "" .HTMLBody = "Attached you will find a copy of your Quality Audit Scorecard. If you would like to challenge your audit, your response must be " & _ "received within 2 business days of the receipt of this message. Challenges received after 2 business days will not be accepted." & _ "<BR><BR>" & "All challenges must be completed using the proper challenge form found within the QA Audit Challenge Process (QLA02); challenges on the wrong form will not be accepted." & _ "<BR><BR>" & "Please see your OE for assistance should you have questions on the challenge process. Do not contact your auditor by phone to challenge an audit." & _ "<BR><BR>" & "Remember that this audit is a way for us to help you achieve the goals and objectives set by management." & _ "<BR><BR>" & "Sincerely," & "<BR><BR>" & "Your Medicare Programs Quality Audit Team" ' Add attachments to the message. If Dir(strAttachTemp) <> "" Then .Attachments.Add (strAttachTemp) End If ' Resolve each Recipient's name. For Each objOutlookRecip In .Recipients objOutlookRecip.Resolve Next ' .Save .Send End With Set objOutlook = Nothing DoCmd.SetWarnings True DoCmd.Echo True ''Remove attachments from C:\Users Kill strAttachTemp ''Kill strAttach1 ''Kill strAttach2 ''Kill strAttach3 ''Kill strAttach4 ''Kill strAttach5 Exit_Handler: Exit Function Err_handler: DoCmd.CancelEvent MsgBox Err.Description Resume Exit_Handler End Function
From novice to tech pro — start learning today.