How to send email to multiple recipients with addresses stored in Excel?

Question

I am trying to set up several buttons on an Excel form to email different groups of people.
I made several ranges of cells on a separate worksheet to list the email addresses.

For example, I want "Button A" to open Outlook and put the list of email addresses from "Worksheet B: Cells D3-D6". Then all that has to be done is hit "Send" in Outlook.

Sub Mail_workbook_Outlook_1() 
    'Working in 2000-2010
    'This example send the last saved version of the Activeworkbook
    Dim OutApp As Object 
    Dim OutMail As Object 
         
    EmailTo = Worksheets("Selections").Range("D3:D6") 
         
    Set OutApp = CreateObject("Outlook.Application") 
    Set OutMail = OutApp.CreateItem(0) 
         
    On Error Resume Next 
    With OutMail 
        .To = EmailTo 
        .CC = "[email protected];[email protected]" 
        .BCC = "" 
        .Subject = "RMA #" & Worksheets("RMA").Range("E1") 
        .Body = "Attached to this email is RMA #" & Worksheets("RMA").Range("E1") & ". Please follow the instructions for your department included in this form." 
        .Attachments.Add ActiveWorkbook.FullName 
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
             
        .Display 
    End With 
    On Error Goto 0 
         
    Set OutMail = Nothing 
    Set OutApp = Nothing 
End Sub

Solution 1

You have to loop through every cell in the range "D3:D6" and construct your To string. Simply assigning it to a variant will not solve the purpose. EmailTo becomes an array if you assign the range directly to it. You can do this as well but then you will have to loop through the array to create your To string

CODE

Option Explicit

Sub Mail_workbook_Outlook_1()
     'Working in 2000-2010
     'This example send the last saved version of the Activeworkbook
    Dim OutApp As Object
    Dim OutMail As Object
    Dim emailRng As Range, cl As Range
    Dim sTo As String
    
    Set emailRng = Worksheets("Selections").Range("D3:D6")
    
    For Each cl In emailRng 
        sTo = sTo & ";" & cl.Value
    Next
    
    sTo = Mid(sTo, 2)
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = sTo
        .CC = "[email protected];[email protected]"
        .BCC = ""
        .Subject = "RMA #" & Worksheets("RMA").Range("E1")
        .Body = "Attached to this email is RMA #" & _
        Worksheets("RMA").Range("E1") & _
        ". Please follow the instructions for your department included in this form."
        .Attachments.Add ActiveWorkbook.FullName
         'You can add other files also like this
         '.Attachments.Add ("C:\test.txt")

        .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Solution 2

ToAddress = "[email protected]"
ToAddress1 = "[email protected]"
ToAddress2 = "[email protected]"
MessageSubject = "It works!."
Set ol = CreateObject("Outlook.Application")
Set newMail = ol.CreateItem(olMailItem)
newMail.Subject = MessageSubject
newMail.RecipIents.Add(ToAddress)
newMail.RecipIents.Add(ToAddress1)
newMail.RecipIents.Add(ToAddress2)
newMail.Send

Comments

[easycheese]

Don't forget to go to Tools-->Reference-->Microsoft Outlook Object Library

[Siddharth Rout]

No you don't need that ;) I am using Late Binding :)

[easycheese]

No idea what that is :) I just ran into that problem.

[Siddharth Rout]

Search Google on Latebinding vs Earlybinding ;)

[Dmitry Streblechenko]

There is absolutely no reason to build a ";" separated To string - just call MailItem.Recipients.Add for each recipient.

[ashleedawg]

Unlike the other answer, this exanple uses the Recipients.Add method, as recommended by the documentation.