How to send email to multiple recipients with addresses stored in Excel?
email, excel, outlook, vba
Solution
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 = "person1@email.com;person2@email.com"
.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
Problem
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 = "person1@email.com;person2@email.com" .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 ```