Dynamically Emailing Reports

[Jessica240]

Hello,

The following code emails a department report to the department manager each pay period. The code works great except that it opens each email one at a time, requiring the user to click "send" for each report before it will move on to the next one.

Private Sub Detail_Click()
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("Current_Dept_List")
If Not rs.BOF And Not rs.EOF Then
    While Not rs.EOF
DoCmd.OpenReport "EE_Detail_Distro", acViewPreview, , "labor_worked=" & rs!Labor_worked
DoCmd.SendObject acSendReport, "", acFormatPDF, rs!email, , , "Labor Budget Summary Report"
DoCmd.Close
rs.MoveNext
    Wend
End If
rs.Close

End Sub

Since we have over 50 departments, I am trying to save the user time by sending out all reports automatically at once and bypass the requirement of the user to click "send" between each of the 50 emails.

Is there a way to do this by chance? The user email program is Outlook 2016.

Thanks in advance for the help!


Jessica

[Micron]

If you're using Outlook, you can control it via automation and have a lot more flexibility such as To lists, CC, BCC, attachments, edit message/or not, etc.
Research "ms access send email with attachment" or similar to get code samples.

[Gicu]

Before you try automation which should definitively work for you see if changing the Docmd.SendObject line to add false for the EditMessage parameter will work:

DoCmd.SendObject acSendReport, "", acFormatPDF, rs!email, , , "Labor Budget Summary Report" ,"",False
SendObject(ObjectType, ObjectName, OutputFormat, To, Cc, Bcc, Subject, MessageText, EditMessage, TemplateFile)

https://docs.microsoft.com/en-us/office/vba/api/access.docmd.sendobject

You might get the security warning but if you have a up-to-date anti-virus you should not in 2016.


If you want to automate Outlook here is a function using late binding that I use:

Function vcSendEmail_Outlook_With_Attachment(sSubject As String, sTo As String, Optional sCC As String, Optional sBcc As String, Optional sAttachment As String, Optional sBody As String)
    Dim OutApp As Object
    Dim OutMail As Object
 
  
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
 
  
 
    Set OutMail = OutApp.CreateItem(0)
 
    OutMail.To = sTo
    If sCC <> "" Then OutMail.CC = sCC
    If sBcc <> "" Then OutMail.BCC = sBcc
    OutMail.Subject = sSubject
    If sBody <> "" Then OutMail.HTMLBody = sBody


    OutMail.Attachments.Add (sAttachment)


    OutMail.Display  'Send | Display


    Set OutMail = Nothing
    Set OutApp = Nothing
End Function

Please note that you will need to save each individual (departmental) report prior to calling this function as sAttachement is the full path to the file to be attached.

Cheers,
Vlad

[Jessica240]

Thank you Gicu. Your code worked like a charm! I certainly do appreciate it.

[Gicu]

Glad to hear!

Cheers,
Vlad