Email Report to Different people

[cbrsix]

I have the following code to send emails to people. This works well.

Private Sub cmdEmailRenewals_Click()
On Error GoTo SendEmail_Err
    Dim myOlApp As Object
    Dim myNameSpace As Object
    Dim myFolder As Object
    Dim myItem As Object
    Dim myAttachments, myRecipient As Object
    Dim recipient As String
    Dim file_name As String
    Dim mySubject As Object
    Dim dbs As Object
    Dim rst As Object
    Dim strSql As String
    
    strSql = "EmailRepAll" 'Select the Query where you want your information to be drawn from
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(strSql)
    rst.MoveFirst
    While Not rst.EOF
        attachments = "Put attachment here"
        recipient = rst![Business Email Address] 'This is the email address that you corresponds to your recipient"
        Set myOlApp = CreateObject("Outlook.Application")
        Set myItem = myOlApp.CreateItem(olMailItem)
        Set myAttachments = myItem.attachments.Add(attachments)
        Set myRecipient = myItem.Recipients.Add(recipient)
        '"Message Subject String Here"
        myItem.Subject = Me.EmailSubject
        '"Put Message Body Text Here"
        myItem.HTMLBody = "Enter text here"
        myItem.Display
        rst.MoveNext
    Wend
    DoCmd.Close acForm, "EmailReps" 'Closes the form
    DoCmd.OpenForm "EmailConfirmation" 'Opens Email Confirmation Form
    Set myRecipient = Nothing
    Set myAttachments = Nothing
    Set myItem = Nothing
    Set myOlApp = Nothing
    Set rst = Nothing
SendEmail_Exit:
    Exit Sub
SendEmail_Err:
    MsgBox Err.Description
    Resume SendEmail_Exit
End Sub

I also have a report that gets generated for all reps. I want to be able to email each rep their respective report utilizing the email code above. I have the following code to open the report for each rep, just can't figure out how to integrate this into the email code to send the report as a PDF attachment.

[Private Sub Label3658_Click()
Dim strWhere As String
If Me.Dirty Then 'Save any edits
Me.Dirty = False
End If
If Me.NewRecord Then 'Check these is a record to print
MsgBox "Select a record to print..."
Else
strWhere = " [Rep Number] = """ & Me.[Rep Number] & """"
DoCmd.OpenReport "RepRenewal", acViewPreview, , strWhere, , "False"
End If
End Sub

[pbaldy]

Using your existing code, you'd use OutputTo immediately after the OpenReport line to save the report as PDF, then attach it. This is one alternative to opening the report filtered:

Emailing a different report to each recipient

[cbrsix]

I know this thread is from last year, but I was unable to get it work back then and had to do it manually because of time constraints. I am back facing this issue again and I am running into the same problems. This is the code I have currently, which is connected to a button on a form. It filters only for the first person and attaches that same report to each email but does not repeat for each one thereafter until the EOF.

Private Sub cmdEmailRenewals_Click()
On Error GoTo SendEmail_Err
    Dim myOlApp As Object
    Dim myNameSpace As Object
    Dim myFolder As Object
    Dim myItem As Object
    Dim myAttachments, myRecipient As Object
    Dim recipient As String
    Dim file_name As String
    Dim mySubject As Object
    Dim dbs As Object
    Dim rst As Object
    Dim strSql As String
    Dim strWhere As String
    
    strSql = "EmailRepAll" 'Select the Query where you want your information to be drawn from
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(strSql)
    rst.MoveFirst
    While Not rst.EOF
        strWhere = " [Rep Number] = """ & rst![Rep Number] & """"
        DoCmd.OpenReport "Renewal", acViewPreview, , strWhere, , "False"
        DoCmd.OutputTo acOutputReport, "Renewal", acFormatPDF, "C:\Users\John Doe\Desktop\Renewal Report.pdf"
        Attachments = " "C:\Users\John Doe\Desktop\Renewal Report.pdf"
        recipient = rst![Business Email Address] 'This is the email address that you corresponds to your recipient"
        Set myOlApp = CreateObject("Outlook.Application")
        Set myItem = myOlApp.CreateItem(olMailItem)
        Set myAttachments = myItem.Attachments.Add(Attachments)
        Set myRecipient = myItem.Recipients.Add(recipient)
        'myItem.BCC = rst![Business Email Address] 'Enter any other email recipient that you want CC'd for this email
        '"Message Subject String Here"
        myItem.Subject = Me.EmailSubject
        '"Put Message Body Text Here"
        myItem.HTMLBody = Me.EmailBody
        myItem.Display
        rst.MoveNext
    Wend
    DoCmd.Close acForm, "EmailReps" 'Closes the form
    DoCmd.OpenForm "EmailConfirmation" 'Opens Email Confirmation Form
    Set myRecipient = Nothing
    Set myAttachments = Nothing
    Set myItem = Nothing
    Set myOlApp = Nothing
    Set rst = Nothing
SendEmail_Exit:
    Exit Sub
SendEmail_Err:
    MsgBox Err.Description
    Resume SendEmail_Exit
End Sub

I looked at the link provided and tried the OpenArgs method but was getting the same result. Thanks for the help!

[pbaldy]

You would have to close the report within the loop. Since it's never closed, the same one gets output.

[cbrsix]

Thank you. I thought I was missing something.

[pbaldy]

No problem.