Link to home
Start Free TrialLog in
Avatar of armymom13
armymom13Flag for United States of America

asked on

Macro in excel to send multiple emails separated by a semi-colon

Hi guys, you wrote the following macro for me last week, and now I am finding out that the user wants to have multiple emails on one line separated by a semi colon... can you show me how write that into this in the macro below?  I will also re-attach the excel spreadsheet we used. thanks

Sub SendEmail()
    Dim OLF As Outlook.MAPIFolder, olMailItem As Outlook.MailItem
    Dim ToContact As Outlook.Recipient
    Dim LastRow As Long, i As Long
    Dim Msg As String
   
    LastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
   
    '~~> loop Through the Range in Excel
    For i = 2 To LastRow
        '~~> creates a new e-mail message
        Set olMailItem = OLF.Items.Add
   
        Msg = "In accordance with your FSA renewal with " & _
        " Ceridian Benefits Services, we require a deposit in the amount shown below.  These funds will be retrieved via an ACH from your FSA provided bank account with an effective date of 12/31/2010 " & vbNewLine & vbNewLine & _
        "Prefund Amount: " & Format(Sheets("Sheet1").Range("D" & i).Value, "$#,##0.00") & vbNewLine & vbNewLine & _
        "Thank You" & vbNewLine & _
        "Ceridian Benefits Services" & vbNewLine & _
        "800-488-8757" & vbNewLine & _
        "seclientservices@ceridian.com "
   
        With olMailItem
            .Subject = "FSA Deposit Requirement - " & _
            Sheets("Sheet1").Range("B" & i).Value & " - " & _
            Sheets("Sheet1").Range("C" & i).Value
           
            Set ToContact = .Recipients.Add(Sheets("Sheet1").Range("A" & i).Value) ' add a recipient
            .Body = Msg
            '<~~ Change the below to .Send when you want to finally send it
            .Display
        End With
    Next
   
    Set ToContact = Nothing
    Set olMailItem = Nothing
    Set OLF = Nothing
End Sub
Sample-3-.xlsm
Avatar of Chris Bottomley
Chris Bottomley
Flag of United Kingdom of Great Britain and Northern Ireland image

Do you mean send to multi contacts .. if so then change:

Set ToContact = .Recipients.Add(Sheets("Sheet1").Range("A" & i).Value) ' add a recipient
to
Set ToContact = .Recipients.Add(Sheets("Sheet1").Range("A" & i).Value) ' add a recipient
Set ToContact = .Recipients.Add(Sheets("Sheet1").Range("A" & i+1).Value) ' add a recipient
Set ToContact = .Recipients.Add(Sheets("Sheet1").Range("B" & i).Value) ' add a recipient

i.e. just repeat the line for the new cell addresses

Chris
Avatar of laudus
laudus

I'm assuming that when you say "multiple emails" you mean you want to have multiple recipients to your email.

If that's the case, then I believe you can Do/Loop or For/Next through as list of recipients and continue to use the ".Recipients.Add" method. Outlook will take care of the semi-colon.

For example:

x = 1 'The first row of your email recipients
Do Until Sheets(1).Range("A" & x).Value = ""
   Set ToContact = .Recipients.Add(Sheets("Sheet1").Range("A" & i).Value) ' add a recipient
Loop

Open in new window

Sorry, error in the copy/paste.  It should read:

Set ToContact = .Recipients.Add(Sheets("Sheet1").Range("A" & x).Value) ' add a recipient
Just realised the requirement so see below:

Chris
Sub SendEmail()
    Dim OLF As Outlook.MAPIFolder, olMailItem As Outlook.MailItem
    Dim ToContact As Outlook.Recipient
    Dim LastRow As Long, i As Long
    Dim Msg As String
    Dim arr() As String
    
    LastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    
    '~~> loop Through the Range in Excel
    For i = 2 To LastRow
        '~~> creates a new e-mail message
        Set olMailItem = OLF.Items.Add
    
        Msg = "In accordance with your FSA renewal with " & _
        " Ceridian Benefits Services, we require a deposit in the amount shown below.  These funds will be retrieved via an ACH from your FSA provided bank account with an effective date of 12/31/2010 " & vbNewLine & vbNewLine & _
        "Prefund Amount: " & Format(Sheets("Sheet1").Range("D" & i).Value, "$#,##0.00") & vbNewLine & vbNewLine & _
        "Thank You" & vbNewLine & _
        "Ceridian Benefits Services" & vbNewLine & _
        "800-488-8757" & vbNewLine & _
        "seclientservices@ceridian.com "
    
        With olMailItem
            .Subject = "FSA Deposit Requirement - " & _
            Sheets("Sheet1").Range("B" & i).Value & " - " & _
            Sheets("Sheet1").Range("C" & i).Value
            arr = Split(Sheets("Sheet1").Range("A" & i).Text, ";")
            For Each elem In arr
                Set ToContact = .Recipients.Add(elem) ' add a recipient
            Next
            .Body = Msg
            '<~~ Change the below to .Send when you want to finally send it
            .Display
        End With
    Next
    
    Set ToContact = Nothing
    Set olMailItem = Nothing
    Set OLF = Nothing
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Chris Bottomley
Chris Bottomley
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of armymom13

ASKER

Perfect, thank you very much