Sending out 2 emails with different attachments

[Thompyt]

How can I do this with 1 click like sending a single email? I have searched the interent and here, but usually get multiple attachments in 1 email.

Private Sub Send_Open_Click()
 On Error GoTo ErrorMsgs
 Dim objOutlook As Outlook.Application
 Dim objOutlookMsg As Outlook.MailItem
 Dim objOutlookAttach As Outlook.Attachment
 Dim objOutlookRecip As Outlook.Recipient
 Dim strBody, strAddresses, strSubject As String
 Dim CRNUM As Variant
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
CRNUM = DLookup("[CR_Numbers]", "[Open_CRs]", "CR_Numbers")
If IsNull(CRNUM) Then
With objOutlookMsg
   .Subject = "There are no Open CR's - " & Format(Date + 1, "dd mmm yyyy")
   .Body = "There are no Change Request actions for tomorrows CMB." & vbCrLf & vbCrLf  & _"
    & V/R" & vbCrLf & vbCrLf & "Name" & vbCrLf & vbCrLf & "Organization" & vbCrLf & "Division" & vbCrLf & "Street" & vbCrLf & "Zip" _&
    vbCrLf & "Phone" & vbCrLf & "Email"
   .Display
    DoCmd.Close acReport, "Open by Level"
Exit Sub
End With
Else
End If
With objOutlookMsg
    .Subject = "Tomorrow's CR's - " & Format(Date + 1, "dd mmm yyyy")
    .Body = "For your use." & vbCrLf & vbCrLf & "V/R" & vbCrLf & vbCrLf & "Name" & vbCrLf & vbCrLf & "Organization" & vbCrLf & "Division" & vbCrLf & "Street" & vbCrLf & "Zip" _
    & vbCrLf & "Phone" & vbCrLf & "Email"
    DoCmd.OutputTo 3, "Open by Level", acFormatPDF, "C:\Temp\Open Changes - " & Format(Date + 1, "dd mmm yyyy") & ".pdf", , 0
    .Attachments.Add ("C:\Temp\Open Changes - " & Format(Date + 1, "dd mmm yyyy") & ".pdf")
   .Display
  Kill "C:\Temp\Open Changes - " & Format(Date + 1, "dd mmm yyyy") & ".pdf"
    DoCmd.Close acReport, "Open by Level"
  End With
 
With objOutlookMsg
     .Subject = "Today's AORB/ERB/CCB outcome - " & Format(Date, "dd mmm yyyy")
     .Body = "Today's AORB/ERB/CCB outcome." & vbCrLf & vbCrLf & strMsg & _
      & "V/R" & vbCrLf & vbCrLf & "Name" & vbCrLf & vbCrLf & "Organization" & vbCrLf & "Division" & vbCrLf & "Street" & vbCrLf & "Zip" _
      & vbCrLf & "Phone" & vbCrLf & "Email"
    DoCmd.OutputTo 3, "Weekly SITREP V", acFormatXLS, "C:\Temp\Summation - " & Format(Date, "dd mmm yyyy") & ".xls", , 0
    DoCmd.Close acForm, "Bi-Summation"
   .Attachments.Add ("C:\Temp\Summation - " & Format(Date, "dd mmm yyyy") & ".xls")
   .To = "HB Rollup"
   .Display
  Kill "C:\Temp\Summation - " & Format(Date, "dd mmm yyyy") & ".xls"
  DoCmd.Close acReport, "Weekly SITREP V"
  End With
Set objOutlookMsg = Nothing
 Set objOutlook = Nothing
 Set objOutlookAttach = Nothing
  Exit Sub
ErrorMsgs:
 If Err.Number = "287" Then
 MsgBox "You clicked No to the Outlook security warning. " & _
 "Rerun the procedure and click Yes to access e-mail " & _
 "addresses to send your message."
 Else
 MsgBox Err.Number & " " & Err.Description
End If
End With
End Sub

This gives me 1 email (The second) with both attachments.

[June7]

Not understanding the issue. If you want to send a second email then just incorporate code to do that.

Why do you show the code split up? Where is the second email code positioned in the Sub?

Step debug. Review link at bottom of my post for debugging guidelines.

[Thompyt]

June, the way I have it set up, I am sending an email with attachment if there is information in the records, otherwise it will send out the email with a statement saying no new issues. I also want to send out another email to a different group with another attachment. The way the code is run now I can see the first email being developed, then it will change automatically to the second email. The second email is position in the start of the "With objOutlookMsg."

I will edit the first post to show the combination I have. What I am looking for is a code to show the end of the email, and start a new email process and not combine them. Make the 2 emails a complete separate process.

BLUF - I want to have 2 emails defined as separate entities with their own attachments.

[June7]

The .Body strings have wrong syntax in the line continuation. You should be getting a compile error.

[Thompyt]

June,
Its just my editing mistakes when I take out the signature block, I think. Otherwise I do not get any compilation errors. I am wanting to create 2 seperate emails. With the below code, it creates the first email, then changes it to the second email. I need it to create the second email in a different message.

PPrivate Sub Send_Daily_Click()
  On Error GoTo ErrorMsgs
  Dim rs As DAO.Recordset
  Dim objOutlook As Outlook.Application
  Dim objOutlookMsg As Outlook.MailItem
  Dim objOutlookAttach As Outlook.Attachment
  Dim strBody, strAddresses, strSubject, strMsg As String
  Dim CRNUM As Variant
 Set rs = CurrentDb.OpenRecordset("SELECT Status,CR_Numbers,[Change Requested]FROM Daily_Actions_Email ORDER BY Status,CR_Number ASC")
 Set objOutlook = CreateObject("Outlook.Application")
 Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
 CRNUM = DLookup("[CR_Numbers]", "[Daily_Actions_Email]", "CR_Numbers")
 If IsNull(CRNUM) Then
 With objOutlookMsg
       .Subject = "There were no actioned CR's - " & Format(Date + 1, "dd mmm yyyy")
     .Body = "There were no actioned Change Requests today." & vbCrLf & vbCrLf & "V/R" & vbCrLf & vbCrLf & "Name" & vbCrLf & vbCrLf & "Command" & vbCrLf & "Division" & vbCrLf & "Address" & vbCrLf & "Zip" & vbCrLf & "Phone" & vbCrLf & "Email"
     .To = "TEWG CCB Results"
    .Display
     DoCmd.Close acReport, "Daily Actions"
 Exit Sub
 End With
 Else
 End If
 rs.MoveFirst
 While Not rs.EOF
  strMsg = strMsg & rs!Status & vbCrLf & Chr(9) & "CR  " & rs!CR_Numbers & " - " & rs![Change Requested] & vbCrLf
  rs.MoveNext
 Wend
  rs.Close
 With objOutlookMsg
    .Subject = "Today's AORB/ERB/CCB outcome - " & Format(Date, "dd mmm yyyy")
    .Body = "Today's AORB/ERB/CCB outcome." & vbCrLf & vbCrLf & strMsg & vbCrLf & vbCrLf & "V/R" & vbCrLf & vbCrLf & "Name" & vbCrLf & vbCrLf & "Command" & vbCrLf & "Division" & vbCrLf & " Address" & vbCrLf & "Zip" & vbCrLf & "Phone" & vbCrLf & "Email"
     DoCmd.OutputTo 3, "Daily Actions", acFormatPDF, "C:\Temp\Daily Actions - " & Format(Date, "dd mmm yyyy") & ".pdf", , 0
     .Attachments.Add ("C:\Temp\Daily Actions - " & Format(Date, "dd mmm yyyy") & ".pdf")
     .To = "TEWG CCB Results"
     .Display
     DoCmd.Close acReport, "Daily Actions"
     Kill "C:\Temp\Daily Actions - " & Format(Date, "dd mmm yyyy") & ".pdf"
  End With
 With objOutlookMsg
      .Subject = "Today's AORB/ERB/CCB outcome - " & Format(Date, "dd mmm yyyy")
      .Body = "Today's AORB/ERB/CCB outcome." & vbCrLf & vbCrLf & strMsg & _
            vbCrLf & vbCrLf & "V/R" & vbCrLf & vbCrLf & "Name" & vbCrLf & vbCrLf & "Command" & vbCrLf & "Division" & vbCrLf & "Address" & vbCrLf & "Zip" & vbCrLf & "Phone" & vbCrLf & "Email"
     DoCmd.OutputTo 3, "Weekly SITREP V", acFormatXLS, "C:\Temp\Summation - " & Format(Date, "dd mmm yyyy") & ".xls", , 0
     DoCmd.Close acForm, "Bi-Summation"
    .Attachments.Add ("C:\Temp\Summation - " & Format(Date, "dd mmm yyyy") & ".xls")
    .To = "HB Rollup"
    .Display
   Kill "C:\Temp\Summation - " & Format(Date, "dd mmm yyyy") & ".xls"
   DoCmd.Close acReport, "Weekly SITREP V"
 End With
  Set objOutlookMsg = Nothing
  Set objOutlook = Nothing
  Set objOutlookAttach = Nothing
  Exit Sub
ErrorMsgs:
  If Err.Number = "287" Then
  MsgBox "You clicked No to the Outlook security warning. " & "Rerun the procedure and click Yes to access e-mail " & "addresses to send your message."
  Else
  MsgBox Err.Number & " " & Err.Description
  End If
  End Sub

[June7]

Problem is there is only one Outlook message object and since you only display it (not send) when the second email code runs it is modifying the object.

So either send instead of display OR declare and set two objects.

Dim objOutlookMsg1 As Outlook.MailItem
Dim objOutlookMsg2 As Outlook.MailItem
Set objOutlookMsg1 = objOutlook.CreateItem(olMailItem)
Set objOutlookMsg2 = objOutlook.CreateItem(olMailItem)

With objOutlookMsg1
...

With objOutlookMsg2
...

[Thompyt]

June,
Thanks, now I can send multiple emails. Much appreciated.