With Experts Exchange’s latest app release, you can now experience our most recent features, updates, and the same community interface while on-the-go. Download our latest app release at the Android or Apple stores today!
Public Function SendEmailEmpCompletedRptNoErrorsNoAction(ByVal varEmpEmail, varAddlEmail As String) On Error GoTo Err_Handler Dim objOutlook As Outlook.Application Dim objOutlookMsg As Outlook.MailItem Dim objOutlookRecip As Outlook.Recipient Dim objOutlookAttach As Outlook.Attachment Dim AttachmentPath As String Dim DisplayMsg As String Dim strAttach1 As String Dim strAttachTemp As String Dim strOutputToTemp As String Dim strAttachCopy As String DoCmd.Echo False DoCmd.SetWarnings False strOutputToTemp = "C:\Windows\Temp\Audit_Completed" & "_" & InquiryNum & ".PDF" DoCmd.Echo False DoCmd.SetWarnings False '''Output to Temp Area (to C Drive) DoCmd.OutputTo acOutputReport, "rptAudit_Emails_EMP_NoErrorsNoAction", acFormatPDF, strOutputToTemp, False strOutputToTemp = "C:\Windows\Temp\Audit_Completed" & "_" & InquiryNum & ".PDF" '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" ' 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 Programs Quality Audit Team" ' Add attachments to the message. If Not IsMissing(AttachmentPath) Then Set objOutlookAttach = .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 Temp folder on C drive 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
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Join the community of 500,000 technology professionals and ask your questions.