Send Multiple report in one email

[Kmahraz]

Hello
I have a code that generate report in access the report are then sent separately via email, i would like to combine both reports into one email.
DistributorEmailMacro.txtDistributorEmailMacro.txt
Sub SendDistReports()


Dim myreport As String
Dim myquery As String
Dim mysubject As String
Dim mytext As String






Dim db As DAO.Database
Dim rs As DAO.Recordset


Set db = CurrentDb
Set rs = db.OpenRecordset("Distributor Emails") 'Opens the table called Distributor Emails


Password = InputBox("This macro sends e-mail reports out to all of the distributors. Input the password to continue", "Input Password to Continue")


If Password = "Karim" Then
Else
Exit Sub

End If




rs.MoveLast
rs.MoveFirst 'Navigate to the first record in the table


Do While Not rs.EOF 'Continue the loop until the last record in the table

'-----------Send Summary by Distributor Report----------------------------
myreport = "D Summary by Distributor"
myquery = "[qu3: Program Level Analysis]![WHOTO]=""" & rs!WHOTO & """ AND [qu3: Program Level Analysis].[Effective_Date]<=#7/1/2015# AND [qu3: Program Level Analysis].[end_date]>=#4/1/2015# AND [qu3: Program Level Analysis].[Chosen Rebate]<>0 Or [qu3: Program Level Analysis].[Chosen Rebate] IS Null" 'Define the query
mysubject = "Pricing Programs - Active Programs Summary for " & rs!WHOTO 'e-mail subject line
mytext = "Dear " & rs!distributor_name & Chr(13) & _
"Attached are the " & rs!WHOTO & " SPP & SCORe programs that were active during Q2. If a program is no longer valid, please let me know. In addition, if a program is expiring shortly and a renewal is desired, please be sure to submit a renewal application in a timely manner. If the report is blank, there are currently no active pricing programs. Please let me know of any questions." & Chr(13) & _
"Sincerely, " & Chr(13) & _
"Kristin Furniss" 'e-mail body text

SendEMail rs!Distributor_Email, myreport, myquery, mysubject, mytext 'Call the subroutine SendEMail


'--------------Send Attainment to Plan Report
myreport = "D Attainment to Plan by Program"
myquery = "[FCST vs ACT Query]![WHOTO]=""" & rs!WHOTO & """" 'Define the query
mysubject = "Pricing Programs - Attainment to Plan Summary for " & rs!WHOTO 'e-mail subject line
mytext = "Dear " & rs!distributor_name & Chr(13) & _


"Attached is the Attainment to Plan report. As noted in my June 26th 'Pricing Programs - Initiation of Quarterly Reporting to Distributors' email, this is for information purposes only, no action is necessary. The pricing team will follow up on significant variances as identified. If the report is blank, this means you have not submitted a rebate form for any current programs. Please let me know of any questions." & Chr(13) & _
"Sincerely," & Chr(13) & _
"Kristin Furniss" 'e-mail body text

SendEMail rs!Distributor_Email, myreport, myquery, mysubject, mytext 'Call the subroutine SendEMail


rs.MoveNext 'navigate to the next record in the table
Loop


End Sub


'------------------------------------------------------------
' Test_E_mail_macro
'
'------------------------------------------------------------
Sub SendEMail(WHOTOemail As String, myreport As String, myquery As String, mysubject As String, mytext As String)
On Error GoTo SendEMail_Err


Dim output As Long


DoCmd.OpenReport myreport, acViewReport, "", myquery, acNormal 'Open the report using the query defined above
DoCmd.SendObject acReport, myreport, "PDFFormat(*.pdf)", WHOTOemail, "", "", mysubject, mytext, False, ""
DoCmd.Close acReport, myreport





SendEMail_Exit:
Exit Sub


SendEMail_Err:
MsgBox Error$
Resume SendEMail_Exit


End Sub

[ranman256]

create a collection of all the files you want to send, then attach them

sub Sendfiles()
dim colFile as new collection


colFile.add "c:\folder\file1.pdf"
colFile.add "c:\folder\file2.pdf"
colFile.add "c:\folder\file3.pdf"


vTo = "jBond@Mi6.com"
vSub = "Those files you wanted"
vBody "my body text"


Send1Email vTo, vSubj, vBody, colFile


end sub


'---------------
Public Function Send1Email (ByVal pvTo, ByVal pvSubj, ByVal pvBody, optional pcolFile as collection) As Boolean
'---------------
Dim oApp As Outlook.Application
Dim oMail As Outlook.MailItem


'-------
'YOU MUST ADD THE OUTLOOK APP IN REFERENCES!!!   checkmark OUTLOOK OBJECTS in the vbE menu, Tools, References
'-------


On Error GoTo ErrMail


Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(olMailItem)


With oMail
    .To = pvTo
    .Subject = pvSubj
    .Body = pvBody
				'add files here
    if not IsMissing(pcolFile) then 
        for i = 1 to pcolFile.count
           .Attachments.Add pcolFile(i), olByValue, 1
        next 
    endif
    
   .Send
End With


EmailO = True
Set oMail = Nothing
Set oApp = Nothing
Exit Function


ErrMail:
MsgBox Err.Description, vbCritical, Err
Resume Next
End Function

[Kmahraz]

Thanks ranman256!
I think the one you sent me is if the reports are saved in a directory, the code i shared in my previous post automatically generate the reports and attach them to the email but one by one.
Looking to add or modify my code so that it attach both reports to one email and send them to the corresponding distributor.
there are over 120 different reports that are generated where 2 of them need to go to the same distributor.
My code work but would like to reduce the number of email i send ...
Best,

[pbaldy]

I deleted your duplicate thread. Please don't post the same question twice. Welcome to the site!

[June7]

Cannot use SendObject. Must save reports to external files (PDF) and attach those files to one email with automation code - as shown by ranman.
Can then delete the files after transmitted.

[Kmahraz]

June 7 & ranman256,
Thank you guys for the response and the information provided, can one of you please assist with the code to delete the files after they are sent.
Best,
Karim

[ranman256]

This does that, attaches 2 or 3 reports, in 1 email.

kill filename

[June7]

To delete all files in a folder in one shot:

Kill "path\*.*"

[Kmahraz]

Thank you Guys, i started using Macros in access just two weeks ago so i'm still new and learning .
Since the reports are going to be generated using the macro in access how do i go by saving them in a specific location, then recognize/ save them with a specific name and pull only the one i need for the specific distributor and attach them to the email.
I have about 60 distributors, each will need to receive two reports rather than duplicating the code is there a way that i can lookup the distributor and match the report (Name) ...
Best,
Karim

[June7]

This is not macro coding - it is VBA. Macros in Access are very different.

Can open a recordset of all distributors and loop through the recordset, like:

Dim rs As ADODB.Recordset, strPath As String
Set rs = New ADODB.Recordset
rs.Open "SELECT DistributorID, email FROM tblDistributors;"
strPath = "path to folder"
While Not rs.EOF
    DoCmd.OpenReport "report1name", acViewPreview, , "DistributorID='" & rs!DistributorID & "'"
    DoCmd.OutputTo acOutputReport, "", acFormatPDF, strPath & "report1" & ".pdf", False
    DoCmd.Close acReport, "report1name", acSaveNo
    DoCmd.OpenReport "report2name", acViewPreview, , "DistributorID='" & rs!DistributorID & "'"
    DoCmd.OutputTo acOutputReport, "", acFormatPDF, strPath & "report2" & ".pdf", False
    DoCmd.Close acReport, "report2name", acSaveNo
'code here to send email and delete the pdf files
    rs.MoveNext
Wend