Draft 4 separate emails at once using VBA

user_8711248 0
Viewed 43

I'm trying to use the code below to draft 4 identical emails to 4 separate addresses contained in my Rlist. This seemed to work yesterday - it drafted all four separately. However, today the email gets drafted and the "to" section shuffles through my Rlist and ends on the last "R" in the list, leaving me with ONE email instead of 4. Let me know if you see the issue please!

Sub EmailAll()

    Dim OApp As Object, OMail As Object, signature As String
    Set OApp = CreateObject("Outlook.Application")
    Set OMail = OApp.CreateItem(0)
   
    Dim Rlist As Range
    Set Rlist = Range("P" & Selection.Row & ":S" & Selection.Row)
    Dim R As Range
    
    For Each R In Rlist
    
        With OMail
        .Display
        End With
            signature = OMail.HTMLbody
        With OMail
        .To = R
        .cc = Sheets("Emails").Range("g2")
        .Subject = ActiveCell & " & " & ActiveCell.Offset(0, 1)
        .HTMLbody = "email contents"
        
        End With
    Next R
    
    Set OMail = Nothing
    Set OApp = Nothing
    End Sub
vba excel
1 Answers

What's creating email objects is the Outlook.Application.CreateItem member call going on here:

    Set OMail = OApp.CreateItem(0)

Since only one single call ever happens, only one email object gets created, and each iteration of the loop successively overwrites the previous iteration until the loop finishes, leaving the email draft in the state set by the last iteration made.

As BigBen correctly pointed out, the solution is to move the OApp.CreateItem(0) instruction inside the loop body, so that each iteration creates a new email.

But the real problem is that your method is doing too many things. Split it up into smaller, more specialized scopes:

Public Sub EmailAll()
    On Error GoTo CleanFail

    Dim OutlookApp As Object
    Set OutlookApp = CreateObject("Outlook.Application")
 
    Dim SourceRow As Long
    SourceRow = Selection.Row

    Dim EmailSubject As String
    'NOTE: Range member calls are implicitly late-bound here
    EmailSubject = ActiveCell.Value & " " & ActiveCell.Offset(0, 1).Value 'possible failure and possible unintended read here

    Dim Recipients As Variant 'a variant array of cell values
    Recipients = ActiveSheet.Range("P" & SourceRow & ":S" & SourceRow).Value

    Dim CopyRecipient As String
    CopyRecipient = ActiveWorkbook.Worksheets("Emails").Range("G2").Value 'possible failure here

    Dim Recipient As Variant 'the value held by a cell
    For Each Recipient In Recipients 'iterating values, not cells
        If Not IsError(Recipient) Then 'cell value may not be a valid string!
            CreateDraftEmail OutlookApp, EmailSubject, Recipient, CopyRecipient
        End If
    Next

CleanExit:
    'Set OutlookApp = Nothing '<~ ONLY do this if NOT doing it causes problems
    Exit Sub

CleanFail:
    Debug.Print Err.Description
    'Stop   '<~ uncomment to always break here for debugging
    'Resume '<~ uncomment to debug/jump to the error-causing statement
    Resume CleanExit
End Sub

Note the several possible points of failure; handling runtime errors gives you an opportunity to fail gracefully instead of popping up some debugger prompt.

By moving the actual email creation into its own procedure scope, responsibilities are better separated and you've taken a chunk of code that does something very specific and moved it into a procedure scope that's named after that very specific thing:

Private Sub CreateDraftEmail(ByVal OutlookApp As Object, ByVal EmailSubject As String, ByVal Recipient As String, ByVal CopyRecipient As String)
    With OutlookApplication.CreateItem(0)

        .Subject = EmailSubject
        .To = Recipient
        .Cc = CopyRecipient
        .HtmlBody = "email contents"

        .Display
    End With
End Sub

Ideally all the prep-work of collecting data from worksheets would also move into its own dedicated scope, so that the values collected can be validated (and any errors gracefully handled) before they are consumed.

Note that ActiveCell and Selection mean that the macro is relying on user selections to do its thing - if the data is always in the same place, it's a good idea to pull it from there and working off Worksheet and Range objects instead of working off the current Selection (which may or may NOT be a Range object - note that this isn't being validated!).

user_11885130
Related