Mail a message to each person in a range
Ron de Bruin (last updated 20-Feb-2010)
Go back to the Mail index page
Important read this :

The code on this page is only working with Outlook and not with Outlook Express or Windows Mail.
If you not use Outlook see the examples in the first section on my mail index page.

Copy the code in a Standard module, if you just started with VBA see this page.
http://www.rondebruin.nl/code.htm

Check out this page for Tips If you want to change the code on this page.
http://www.rondebruin.nl/mail/tips2.htm



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 TestFile()
    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 or not

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 TestFile_2()
    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 the Intellisense help showing you the properties and methods of the objects as you
type you can use Early binding. (bit faster but have problems when you distribute your workbooks)

See Dick's site for a explanation
http://www.dicks-clicks.com/excel/olBinding.htm

Add a reference to the Microsoft outlook Library

1) Go to the VBA editor, Alt -F11
2) Tools>References in the Menu bar
3) Place a Checkmark before Microsoft Outlook ? Object Library
    ? is the Excel 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

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

Set OutMail = OutApp.CreateItem(olMailItem)