How to send one email to list of email addresses in Excel workbook?

Question

I want to send to a list of email addresses in my workbook.

How would I go about that with what I have for the mailing section of my code?

I want to have column R named mailing list and it will send to whatever email addresses are inserted into that column/list all together.

Sub SendReminderMail1()

    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim OutApp As Object
    Dim OutMail As Object

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb1 = ActiveWorkbook

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Copy of " & wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
    FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
    Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

    wb2.Worksheets(1).Range("A1").Value = "Copy created on " & Format(Date, "dd-mmm-yyyy")

    wb2.Save

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = " "
        .CC = ""
        .BCC = ""
        .Subject = "Rotations needed for ."
        .Body = "Hey there,  equipment needs to be rotated."
        .Attachments.Add wb2.FullName

        .Display   'or use .Send to send with display proof reading
    
    End With
    On Error GoTo 0
    wb2.Close savechanges:=False

    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
    MsgBox "Your Automated Email for BP Rotations was successfully ran at " & TimeValue(Now), vbInformation
    
End Sub

Answer 1

In your code I've you set the recipients fields to empty strings:

With OutMail
    .To = " "
    .CC = ""
    .BCC = ""

Instead, you need to read values from the column R and add recipients for the email. To add recipients I'd recommend using the Recipients collection which can be retrieved using the corresponding property of the MailItem class.

Dim recipients As Outlook.Recipients = Nothing

Set recipients = mail.Recipients

' now we add new recipietns to the e-mail
        recipientTo = recipients.Add("Eugene")
        recipientTo.Type = Outlook.OlMailRecipientType.olTo
        recipientCC = recipients.Add("Dmitry")
        recipientCC.Type = Outlook.OlMailRecipientType.olCC
        recipientBCC = recipients.Add("[email protected]")
        recipientBCC.Type = Outlook.OlMailRecipientType.olBCC
        recipients.ResolveAll()

Read more about that in the How To: Fill TO,CC and BCC fields in Outlook programmatically article.

Answer 2

Mail Merge not your cup of tea huh...

Maybe what you need is a Do while Loop where it references a cell in a Table of people, then moves down each step till the E-mail is blank just chugging through Row after Row of E-mails driving that sweet CPU usage up.

Like a user programmed Mail Merge but in Excel and not in a Word Processor... Like Mail Merge... In Word, but not in Word, In Excel In VBA...