Emailing Multiple Invoices As Attachments To Different Email Addresses (1 Viewer)

[TCalvert]

I have over 80 pdf reports that I need to email automatically. Do I need to run a program to open each report individually to email, each report is going to a different email address. Thank you in advance.

 

[Minty]

If the reports are specific to the recipient email address, then you would have to create an email with the appropriate attachment each time.
Are the reports created in Access? If so there is nothing to stop you from creating all the reports in one go, saving them in a suitable way to identify the recipient then simply looping through and creating the emails and adding the appropriate attachment.

It doesn't gain much over doing the individual file creation then, the email as a process though.

 

[TCalvert]

If the reports are specific to the recipient email address, then you would have to create an email with the appropriate attachment each time.
Are the reports created in Access? If so there is nothing to stop you from creating all the reports in one go, saving them in a suitable way to identify the recipient then simply looping through and creating the emails and adding the appropriate attachment.

It doesn't gain much over doing the individual file creation then, the email as a process though.

I am not sure how they can be saved and identified though as the email address to send is in the database.

 

[Minty]

Take a step back. Two questions;
Are these PDF reports created from the Database?
Are you trying to send 1 different report to 80 different email addresses or 80 reports (e.g 80 attachments!) to different email addresses?

 

[TCalvert]

Take a step back. Two questions;
Are these PDF reports created from the Database?
Are you trying to send 1 different report to 80 different email addresses or 80 reports (e.g 80 attachments!) to different email addresses?

Minty I am creating the reports in the database and have 80 different reports to send to 80 different emails.

 

[Minty]

Okay, I think that will be relatively simple, can you show us the code used to create the reports, and can you indicate if the report query has the email address in it?
Based on that we should be able to add in the code to create an email with the specific report.

 

[TCalvert]

Okay, I think that will be relatively simple, can you show us the code used to create the reports, and can you indicate if the report query has the email address in it?
Based on that we should be able to add in the code to create an email with the specific report.

Currently they are opened just by using the docmd.openreport function which opens all the reports. The query has the email address in it.

 

[Minty]

Are you opening the reports filtered to a specific client, or producing an 80 page report with a page per client/email address?
(Hence asking you to see the exact code you are using)

 

[TCalvert]

Are you opening the reports filtered to a specific client, or producing an 80 page report with a page per client/email address?
(Hence asking you to see the exact code you are using)

Minty thank you for taking the time to reply to me and I am opening all 80 reports at once.

 

[Gasman]

Minty thank you for taking the time to reply to me and I am opening all 80 reports at once.

(Hence asking you to see the exact code you are using) ?

 

[TCalvert]

(Hence asking you to see the exact code you are using) ?

Sorry!!

It is just this DoCmd.OpenReport "rptDetails", acViewPreview

 

[Minty]

Okay - you seem reluctant to post the actual code, so I'm going to have to invent report names and field names with my take on this.
I'll stab a guess that you need to therefore actually create 80 individual reports, 1 per email address.
This will involve filtering your report to the data for a single email address.

Attach this code to a command button that would normally open your reports.

    Dim rs              As Recordset
    Dim strSQL          As String
    Dim strWhere        As String
    Dim strFileName     As String
 
    strSQL = "SELECT YourEmailField, YourClientCodeField FROM YourReportQuery"
 
    'Open a recordset of your email addresses from your reports underlying query
    Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
 
    If rs.EOF Or rs.BOF Then
        MsgBox "No records for report!"
        Exit Sub
    End If
    rs.MoveFirst
      
    While Not rs.EOF
        '   Set up the filter
        strWhere = "YourEmailField = '" & rs.Fields("YourEmailField") & "'"
      
        '   We need to save the files with a unique name
        strFileName = Application.CurrentProject.Path & "\InvReport_" & rs.Fields("YourClientCodeField")
        '   Now open the filtered report and save it
        DoCmd.OpenReport "rptDetails", acViewPreview, , strWhere, acWindowNormal
        DoCmd.OutputTo acOutputReport, , pdf, strFileName, , , , acExportQualityPrint
        DoCmd.Close acReport, "rptDetails"
        rs.MoveNext
    Wend
    
    rs.Close
    Set rs = Nothing

I've adjusted it to your report name.
This will hopefully do stage 1 - creating your individual reports.
Examine the code and replace the generic field names with your specific ones.

I think I have added enough comments to make it clear what is happening?

 

[TCalvert]

Okay - you seem reluctant to post the actual code, so I'm going to have to invent report names and field names with my take on this.
I'll stab a guess that you need to therefore actually create 80 individual reports, 1 per email address.
This will involve filtering your report to the data for a single email address.

Attach this code to a command button that would normally open your reports.

    Dim rs              As Recordset
    Dim strSQL          As String
    Dim strWhere        As String
    Dim strFileName     As String

    strSQL = "SELECT YourEmailField, YourClientCodeField FROM YourReportQuery"

    'Open a recordset of your email addresses from your reports underlying query
    Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)

    If rs.EOF Or rs.BOF Then
        MsgBox "No records for report!"
        Exit Sub
    End If
    rs.MoveFirst
     
    While Not rs.EOF
        '   Set up the filter
        strWhere = "YourEmailField = '" & rs.Fields("YourEmailField") & "'"
     
        '   We need to save the files with a unique name
        strFileName = Application.CurrentProject.Path & "\InvReport_" & rs.Fields("YourClientCodeField")
        '   Now open the filtered report and save it
        DoCmd.OpenReport "rptDetails", acViewPreview, , strWhere, acWindowNormal
        DoCmd.OutputTo acOutputReport, , pdf, strFileName, , , , acExportQualityPrint
        DoCmd.Close acReport, "rptDetails"
        rs.MoveNext
    Wend
   
    rs.Close
    Set rs = Nothing

I've adjusted it to your report name.
This will hopefully do stage 1 - creating your individual reports.
Examine the code and replace the generic field names with your specific ones.

I think I have added enough comments to make it clear what is happening?

Thank you, I will give this a go tomorrow.

 

[TCalvert]

Thank you, I will give this a go tomorrow.

Okay - you seem reluctant to post the actual code, so I'm going to have to invent report names and field names with my take on this.
I'll stab a guess that you need to therefore actually create 80 individual reports, 1 per email address.
This will involve filtering your report to the data for a single email address.

Attach this code to a command button that would normally open your reports.

    Dim rs              As Recordset
    Dim strSQL          As String
    Dim strWhere        As String
    Dim strFileName     As String

    strSQL = "SELECT YourEmailField, YourClientCodeField FROM YourReportQuery"

    'Open a recordset of your email addresses from your reports underlying query
    Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)

    If rs.EOF Or rs.BOF Then
        MsgBox "No records for report!"
        Exit Sub
    End If
    rs.MoveFirst
     
    While Not rs.EOF
        '   Set up the filter
        strWhere = "YourEmailField = '" & rs.Fields("YourEmailField") & "'"
     
        '   We need to save the files with a unique name
        strFileName = Application.CurrentProject.Path & "\InvReport_" & rs.Fields("YourClientCodeField")
        '   Now open the filtered report and save it
        DoCmd.OpenReport "rptDetails", acViewPreview, , strWhere, acWindowNormal
        DoCmd.OutputTo acOutputReport, , pdf, strFileName, , , , acExportQualityPrint
        DoCmd.Close acReport, "rptDetails"
        rs.MoveNext
    Wend
   
    rs.Close
    Set rs = Nothing

I've adjusted it to your report name.
This will hopefully do stage 1 - creating your individual reports.
Examine the code and replace the generic field names with your specific ones.

I think I have added enough comments to make it clear what is happening?

Minty I have changed the code to the exact query and report names but the report won't open stating it doesn't exist, what have I done wrong

Private Sub cmdProduceReport_Click()
Dim rs As Recordset
Dim strSQL As String
Dim strWhere As String
Dim strFileName As String

strSQL = "SELECT Email FROM qryStatementTotalnvoice"

'Open a recordset of your email addresses from your reports underlying query
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)

If rs.EOF Or rs.BOF Then
MsgBox "No records for report!"
Exit Sub
End If
rs.MoveFirst

While Not rs.EOF
' Set up the filter
strWhere = "Email = '" & rs.Fields("Email") & "'"

' We need to save the files with a unique name
strFileName = Application.CurrentProject.Path & "\InvReport_" & rs.Fields("Email")
' Now open the filtered report and save it
DoCmd.OpenReport "rptStatementTotalnvoice", acViewPreview, , strWhere, acWindowNormal
DoCmd.OutputTo acOutputReport, , pdf, strFileName, , , , acExportQualityPrint
DoCmd.Close acReport, "rptStatementTotalnvoice"
rs.MoveNext
Wend

rs.Close
Set rs = Nothing
End Sub

 

[Minty]

I think you have misspelt rptStatementTotalnvoice shouldn't it be
rptStatementTotalInvoice

 

[TCalvert]

I think you have misspelt rptStatementTotalnvoice shouldn't it be
rptStatementTotalInvoice

OMG that is with my glasses on too!!

Right that is fixed and it works except it is asking for output each time and I have to select pdf, also when saved on the network drive they are not saving as .pdf it ends after the email address.

 

[Minty]

Ah - sorry I was distracted writing that line - The two bits to change should be

strFileName = Application.CurrentProject.Path & "\InvReport_" & rs.Fields("Email") & ".pdf"
' Now open the filtered report and save it
DoCmd.OpenReport "rptStatementTotalInvoice", acViewPreview, , strWhere, acWindowNormal
DoCmd.OutputTo acOutputReport, , acFormatPDF, strFileName, , , , acExportQualityPrint


I would be cautious using the email as part of a filename, just in case it contains illegal characters

 

[TCalvert]

Ah - sorry I was distracted writing that line - The two bits to change should be

strFileName = Application.CurrentProject.Path & "\InvReport_" & rs.Fields("Email") & ".pdf"
' Now open the filtered report and save it
DoCmd.OpenReport "rptStatementTotalInvoice", acViewPreview, , strWhere, acWindowNormal
DoCmd.OutputTo acOutputReport, , acFormatPDF, strFileName, , , , acExportQualityPrint


I would be cautious using the email as part of a filename, just in case it contains illegal characters

that has worked!!!!

You are an absolute star.

So can we now program automatically emailing the reports?

 

[Minty]

Okay - This code uses Outlook Automation, it is more complicated than a simple Docmd.SendObject, but way more customisable.

    Dim rs              As Recordset
    Dim strSQL          As String
    Dim strWhere        As String
    Dim strFileName     As String

    Dim OutApp          As Object
    Dim OutMail         As Object
    Dim strEmailAdd     As String
    Dim strMsg          As String
    Dim strSubject      As String
    Dim Current_Time    As Integer
    Dim Greeting        As String
    Dim strSignature    As String
        
    strSQL = "SELECT Email FROM qryStatementTotalnvoice"

    'Open a recordset of your email addresses from your reports underlying query
    Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)

    If rs.EOF Or rs.BOF Then
        MsgBox "No records for report!"
        Exit Sub
    End If
    rs.MoveFirst
    
    Current_Time = Hour(Now())

    If Current_Time < 12 Then
        Greeting = "Morning "
    ElseIf Current_Time >= 18 Then
        Greeting = "Evening "
    Else
        Greeting = "Afternoon "
    End If
    
    strSubject = "Your latest Invoice Statement"
    strMsg = "<style> " & _
        "p {font-size:11pt; font-family:Calibri}" & _
        "</style>" & _
        "<p>" & "Good " & Greeting & "," & "</p>" & _
        "<p>" & "" & "</p>" & _
        "<p>" & "Attached is the your latest staetment. " & _
        "<p>" & "Any queries please let me know. " & _
        "<p>" & "Thank You"
    
    While Not rs.EOF
        ' Set up the filter
        strEmailAdd = rs.Fields("Email")
        strWhere = "Email = '" & strEmailAdd & "'"

        ' We need to save the files with a unique name
        strFileName = Application.CurrentProject.Path & "\InvReport_" & strEmailAdd & ".PDF"
        ' Now open the filtered report and save it
        DoCmd.OpenReport "rptStatementTotalnvoice", acViewPreview, , strWhere, acWindowNormal
        DoCmd.OutputTo acOutputReport, , acFormatPDF, strFileName, , , , acExportQualityPrint
        DoCmd.Close acReport, "rptStatementTotalnvoice"
        
        '   OUTLOOK Sending Bits
        Set OutApp = CreateObject("Outlook.Application")
        OutApp.Session.Logon
        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
            .BodyFormat = 2 'olFormatHTML
            .Display
        End With
        ' This grabs your default signature saves it ready to add to the email with the attachment.
        strSignature = OutMail.HTMLBody
        
        With OutMail
    
            .To = strEmailAdd
            .CC = ""
            .BCC = ""
            .Subject = strSubject
            '.MailItem.ReplyRecipients.Add = "flibble@somewhere.com"
            '.SentOnBehalfOfName = "flibble@somewhere.com"
            .Attachments.Add strFileName
            .HTMLBody = strMsg & strSignature
            .Display   'or use .Send to immediately send. As this runs with .Display it will save the emails in your drafts.
            .ReadReceiptRequested = False
        End With
        On Error GoTo 0
        
        Set OutMail = Nothing
        Set OutApp = Nothing
        
        rs.MoveNext
    Wend

    rs.Close
    Set rs = Nothing
End Sub

 

[TCalvert]

Okay - This code uses Outlook Automation, it is more complicated than a simple Docmd.SendObject, but way more customisable.

    Dim rs              As Recordset
    Dim strSQL          As String
    Dim strWhere        As String
    Dim strFileName     As String

    Dim OutApp          As Object
    Dim OutMail         As Object
    Dim strEmailAdd     As String
    Dim strMsg          As String
    Dim strSubject      As String
    Dim Current_Time    As Integer
    Dim Greeting        As String
    Dim strSignature    As String
       
    strSQL = "SELECT Email FROM qryStatementTotalnvoice"

    'Open a recordset of your email addresses from your reports underlying query
    Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)

    If rs.EOF Or rs.BOF Then
        MsgBox "No records for report!"
        Exit Sub
    End If
    rs.MoveFirst
   
    Current_Time = Hour(Now())

    If Current_Time < 12 Then
        Greeting = "Morning "
    ElseIf Current_Time >= 18 Then
        Greeting = "Evening "
    Else
        Greeting = "Afternoon "
    End If
   
    strSubject = "Your latest Invoice Statement"
    strMsg = "<style> " & _
        "p {font-size:11pt; font-family:Calibri}" & _
        "</style>" & _
        "<p>" & "Good " & Greeting & "," & "</p>" & _
        "<p>" & "" & "</p>" & _
        "<p>" & "Attached is the your latest staetment. " & _
        "<p>" & "Any queries please let me know. " & _
        "<p>" & "Thank You"
   
    While Not rs.EOF
        ' Set up the filter
        strEmailAdd = rs.Fields("Email")
        strWhere = "Email = '" & strEmailAdd & "'"

        ' We need to save the files with a unique name
        strFileName = Application.CurrentProject.Path & "\InvReport_" & strEmailAdd & ".PDF"
        ' Now open the filtered report and save it
        DoCmd.OpenReport "rptStatementTotalnvoice", acViewPreview, , strWhere, acWindowNormal
        DoCmd.OutputTo acOutputReport, , acFormatPDF, strFileName, , , , acExportQualityPrint
        DoCmd.Close acReport, "rptStatementTotalnvoice"
       
        '   OUTLOOK Sending Bits
        Set OutApp = CreateObject("Outlook.Application")
        OutApp.Session.Logon
        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
            .BodyFormat = 2 'olFormatHTML
            .Display
        End With
        ' This grabs your default signature saves it ready to add to the email with the attachment.
        strSignature = OutMail.HTMLBody
       
        With OutMail
   
            .To = strEmailAdd
            .CC = ""
            .BCC = ""
            .Subject = strSubject
            '.MailItem.ReplyRecipients.Add = "flibble@somewhere.com"
            '.SentOnBehalfOfName = "flibble@somewhere.com"
            .Attachments.Add strFileName
            .HTMLBody = strMsg & strSignature
            .Display   'or use .Send to immediately send. As this runs with .Display it will save the emails in your drafts.
            .ReadReceiptRequested = False
        End With
        On Error GoTo 0
       
        Set OutMail = Nothing
        Set OutApp = Nothing
       
        rs.MoveNext
    Wend

    rs.Close
    Set rs = Nothing
End Sub

that is fantastic, I will give it a go.

Thank you so very much, have a wonderful weekend.