Excel macro to send e-mail to multiple agents with a different body for each 1

[techguy2010]

Hello,

I'm trying to find a way to send multiple e-mails at once, to different recipients, each with a different e-mail body message, based upon the specific cell values on the spreadsheet. There will be 2 people on each e-mail, one for the main person and a CC for an additional person. The subject line will be the same for each e-mail and the e-mail body will contain specific information for each e-mail. I have code gathered and the initial e-mail works great (as it loops through each e-mail address in Columns A & B, but the e-mail bodys repeat what was in row 2 for Columns D, E and F. Here is a sample of the spreadsheet information



Below is the working code I have that needs help to get it to create an e-mail for each row containing the information in the Column cell values. Specifically trying to get the strBody strings to not have the specific cells coded in the code below, but if there is a way to get it to loop the range like it does the e-mail addresses.

Sub SendEmails()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim rngTo As Range
    Dim strTo As String
    Dim strCC As String
    Dim strSubject As String
    Dim strBody1 As String
    Dim strBody2 As String
    Dim strBody3 As String

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

    'Loop through each row in the sheet
    For Each rngTo In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
        'Get the email addresses from column A
        strTo = rngTo.Value

        'Get the CC email address from cell E2
        strCC = Range("B2").Value

        'Get the subject from cell F2
        strSubject = Range("C2").Value

        'Get the body text from Column D
        strBody1 = Range("D2").Value
       
        'Get the body text from Column E
        strBody2 = Range("E2").Value
       
        'Get the body text from Column F
        strBody3 = Range("F2").Value

        'Create a new email
        Set OutMail = OutApp.CreateItem(olMailItem)

        'Set the email properties
        With OutMail
            .To = strTo
            .CC = strCC
            .Subject = strSubject
            .HTMLBody = strBody1 & "<br/><br/>" & strBody2 & "<br/><br/>" & strBody3
            .Send
        End With

        'Clean up
        Set OutMail = Nothing

    Next rngTo

    Set OutApp = Nothing

End Sub

Any help is appreciated. Please let me know if you need any additional information

 

[Andrzejek]

So close....

Dim intRow As Integer
...
    'Loop through each row in the sheet
intRow = 2
    For Each rngTo In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
        'Get the email addresses from column A
        strTo = Range("A" & intRow).Value

        'Get the CC email address from cell E2
        strCC = Range("B" & intRow).Value
...
        intRow = intRow + 1
    Next rngTo

 

[combo]

To make referencing easier i would either pick data from range to variant array (vData=rngData) or reference range cells by indexes:

Dim rngData As Range
Dim iRngRows As Integer, i As Integer
Dim sHTMLBody As String
Set rngData = Worksheets(1).Range("A1").CurrentRegion ' if no other data next to range
With rngData
    iRngRows = .Rows.Count
    ' iRngCols = .Columns.Count
    For i = 2 To iRngRows
        'Get the email addresses
        strTo = .Cells(i, 1).Value
        'Get the CC email
        strCC = .Cells(i, 2).Value
        'Get the subject
        strSubject = .Cells(i, 3).Value
        'Get the HTML body, possible loop for variable number of columns
        sHTMLBody = .Cells(i, 4).Value & "<br/><br/>" & .Cells(i, 5).Value & "<br/><br/>" & .Cells(i, 6).Value
        ' mailing
        ' ...
    Next i
End With

 

[techguy2010]

So close....

Dim intRow As Integer
...
    'Loop through each row in the sheet
intRow = 2
    For Each rngTo In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
        'Get the email addresses from column A
        strTo = Range("A" & intRow).Value

        'Get the CC email address from cell E2
        strCC = Range("B" & intRow).Value
...
        intRow = intRow + 1
    Next rngTo

This worked out great! Thank you!