VBA - Sending an Outlook Email to unknown number of recipients

Question

Almost a month ago, I have already posted a question that is somewhat similar with this current question of mine.

Sending Outlook Email with multiple recipients from Excel file

But today, I want to develop codes that do not care whether the TO field only contains 1 recipient and perhaps EMPTY for CC. I was able to come up with this two types of codes:

A.

   'Set Recipients
    Range("A2").Select
        Set Recipient = Range(ActiveCell, ActiveCell.End(xlDown))

    'Set Recipients
    Range("B2").Select
        Set CC = Range(ActiveCell, ActiveCell.End(xlDown))


    On Error Resume Next

        With OutlookMailItem

            .Display

            'Assign Recipients in TO field
            For Each sTo In Recipient
                Set myRecipient = OutlookMailItem.Recipients.Add(sTo)
                myRecipient.Type = olTo
                myRecipient.Resolve
                If Not myRecipient.Resolved Then
                    myRecipient.Delete
                End If
            Next sTo

            'Assign CCs in CC field
            For Each sCc In CC
                Set myCc = OutlookMailItem.Recipients.Add(sCc)
                myCc.Type = olCC
                myCc.Resolve
                If Not myCc.Resolved Then
                    myCc.Delete
                End If
            Next sCc
        End With

However, these codes only works with two and more email addresses. When I tried to supply only 1 value for TO and none for CC, it displays Run-time error '-2147352567 (80020009)' : There must be at least one name or contact group in the To, Cc, or Bcc box.

B.

For Each sTo in Recipients
    receiver = receiver & sTo.Value & ";"
Next

For Each sCc in CC
    CCs = CCs & sCc.Value & ";"
Next

But these codes lead to an unresponsive Excel file.

Is there an error with my codes? Or any suggestions on how I can make my TO and CC fields dynamic. Dynamic in a sense that I could assign ONE or MORE for TO and NONE or MORE for CC.

score 1 · Answer 1 · answered Nov 28 '17 at 07:03

Something like this maybe (untested)

Dim rngTo As Range, rngCC As Range

With ActiveSheet
    'using xlUp is typically safer than xlDown...
    Set rngTo = .Range(.Range("A2"), .Cells(.Rows.Count, 1).End(xlUp))
    Set rngCC = .Range(.Range("B2"), .Cells(.Rows.Count, 2).End(xlUp))
End With

AddRecipients OutlookMailItem, rngTo, olTo
AddRecipients OutlookMailItem, rngCC, olCC

Since there's a lot of common code you can create a sub to handle adding the recipients:

Sub AddRecipients(olMail, rng As Range, recipType)
    Dim c As Range, myRecipient
    For Each c In rng.Cells
        If c.Value <> "" Then
            Set myRecipient = olMail.Recipients.Add(c.Value)
            myRecipient.Type = recipType
            myRecipient.Resolve
            If Not myRecipient.Resolved Then myRecipient.Delete
        End If
    Next c
End Sub

"not working" is not a useful description of what happens when you run code. What exactly is the problem? — Tim Williams, Nov 28 '17 at 15:37

score 1 · Answer 2 · answered Nov 28 '17 at 07:09

Problem in your code is that in case of zero or one recipient (or CC) your Recipient variable contains almost entire column. For code A, the problem is that there are many empty cells and looping through them results in There must be at least one name or contact group in the To, Cc, or Bcc box error. For code B, I guess looping through 1 048 576 rows (twice!) is just a little too much for excel.

VBA - Sending an Outlook Email to unknown number of recipients

2 Answers2