How to use Outlook to send email to multiple recipients in Excel VBA

Question

I am trying to set up several buttons in an Excel form to send email to different groups of people. I made several ranges of cells on a separate sheet to list individual email addresses. For example, I want Button A to open Outlook and put a list of email addresses from Worksheet B: Cells D3-D6. Then all you have to do is click Submit in Outlook.

Here is my VBA code so far, but I can't get it to work. Can someone tell me what I am missing or something is wrong, please?

VB:

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 = " [e-mail] ; [e-mail] " .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 

Answer 1

You need to go through each cell of the "D3:D6" range and build a To line. Simply assigning this option will not solve the goal. EmailTo becomes an array if you assign a range to it. You can also do this, but then you have to iterate over the array to create a To string

Is that what you are trying? ( TEST AND TEST )

 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 = " [e-mail] ; [e-mail] " .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 

Answer 2

 ToAddress = " [e-mail] " ToAddress1 = " [e-mail] " ToAddress2 = " [e-mail] " 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