Kmahraz
Member
I have a code that generate report in Access/ Excel the report are then sent separately via email, i would like to combine both reports into one email.
Code:
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 = "XXXX" 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