Microsoft Excel

Ron de Bruin
Excel Automation

Microsoft MVP Program

Mail a message to each person in a range

Important read this :

The code on this page is only working when you use Outlook as your mail program.
Copy the code in a Standard module of your workbook, if you just started with VBA see this page.
Where do I paste the code that I find on the internet

Check out this Tip page for changing the code on this page.
Tips for changing the code examples

 

Example 1

Make a list on the ActiveSheet with :
In column A : Names of the people
In column B : E-mail addresses
In column C : yes or no ( if the value is yes it will create a mail)

The Macro will loop through each row on the Activesheet and if there is a E-mail address in column B and "yes" in column C it will create a mail with a reminder like the one below for each person. If you have duplicate addresses in the column check out this example.


Dear Jelle (Jelle is a name in column A for example)

Please contact us to discuss bringing your account up to date

Sub Test1()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo cleanup
    For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "C").Value) = "yes" Then

            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = "Reminder"
                .Body = "Dear " & Cells(cell.Row, "A").Value _
                      & vbNewLine & vbNewLine & _
                        "Please contact us to discuss bringing " & _
                        "your account up to date"
                'You can add files also like this
                '.Attachments.Add ("C:\test.txt")
                .Send  'Or use Display
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
    Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Tips

 You can also use the values of cells in a range as the body text.
This example will add all the text/values that are in the range G1:G20 to the body.

Add this code to the sub before the loop start

     Dim strbody As String
     For Each cell In Range("G1:G20")
         strbody = strbody & cell.Value & vbNewLine
     Next

And replace the body line with this one

     .Body = "Dear " & Cells(cell.Row, "A").Value & vbNewLine & vbNewLine & strbody

If you want to create emails that are formatted you can use HTMLBody (Office 2000 and up) instead of Body. You can find a lot of WebPages on the internet with more HTML tags examples.

    .HTMLBody = "<H3><B>Dear " & cell.Offset(0, -1).Value & "</B></H3>" & _
         "Please contact us to discuss bringing your account up to date.<BR><BR>" & _
             "<B>Regards Ron de Bruin</B>"

 

Example 2

Make a list on the ActiveSheet with :
In column A : Names of the people
In column B : E-mail addresses
In column C :yes or no ( if the value is yes it will create a mail)

Note: You can also use a formula in column C that display yes if a condition is true, this example will display "yes" if the date in column E is within 90 days of today's date. =IF((E1-TODAY())>90,"No","Yes")

In column D :The macro will add "send" in D when you send the mail
                    (next time you run the macro it will not mailed again)
In column E :Date that you want to check with the formula in C to decide if you want to send the mail

The Macro will loop through each row on the Activesheet and if there is a E-mail address in column B and "yes" in column C and not "send" in column D it will create a mail with a reminder like the one below for each person in the range


Dear Jelle (Jelle is a name in column A for example)

Please contact us to discuss bringing your account up to date

Sub Test2()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo cleanup
    For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "C").Value) = "yes" _
           And LCase(Cells(cell.Row, "D").Value) <> "send" Then

            Set OutMail = OutApp.CreateItem(0)

            On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = "Reminder"
                .Body = "Dear " & Cells(cell.Row, "A").Value _
                      & vbNewLine & vbNewLine & _
                        "Please contact us to discuss bringing " & _
                        "your account up to date."
                'You can add files also like this
                '.Attachments.Add ("C:\test.txt")
                .Send  'Or use Display
            End With
            On Error GoTo 0
            Cells(cell.Row, "D").Value = "send"
            Set OutMail = Nothing
        End If
    Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

 

Early Binding

If you want to use the Intellisense help showing you the properties and methods of the objects as you type you can use Early Binding. Bit faster also when you run your code but you can have problems when you distribute your workbooks. Excel will automatic update the reference number to Outlook when you open your workbook in a higher version of Excel/Outlook but not update it when you open it in a lower version of Excel/Outlook. With Late Binding as I used in the macro examples you not have this problem.

Add a reference to the Microsoft Outlook Library in Excel

1) Go to the VBA editor with the shortcut Alt - F11
2) Click on Tools>References in the Menu bar
3) Place a Checkmark before Microsoft Outlook ? Object Library
    Where ? is the Outlook version number

Then replace this three lines in the code

Dim OutApp As Object
Dim OutMail As Object

Set OutMail = OutApp.CreateItem(0)


With this three lines

Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem

Set OutMail = OutApp.CreateItem(olMailItem)