I am not sure how they can be saved and identified though as the email address to send is in the database.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.
Minty I am creating the reports in the database and have 80 different reports to send to 80 different emails.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?
Currently they are opened just by using the docmd.openreport function which opens all the reports. The query has the email address in it.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.
Minty thank you for taking the time to reply to me and I am opening all 80 reports at once.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)
(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.
Sorry!!(Hence asking you to see the exact code you are using) ?
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
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.
Rich (BB code):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.
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 wrongOkay - 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.
Rich (BB code):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?
OMG that is with my glasses on too!!I think you have misspelt rptStatementTotalnvoice shouldn't it be
rptStatementTotalInvoice
that has worked!!!!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
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.Okay - This code uses Outlook Automation, it is more complicated than a simple Docmd.SendObject, but way more customisable.
Code: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