Sending a personalized email from Excel VBA

Question

Would anyone be so kind and help me out with my problem? I have this example table:

I would like to send a personalized email for each row, this is what I got so far:

Sub SendEmails()
   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("A").Cells.SpecialCells(xlCellTypeConstants)

        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
            .To = cell.Value 
            .Subject = "Project" & Sheets("Sheet1").Range("C").Value        ' insert subject from column C
            .HTMLBody = "<p>Hello " & Sheets("Sheet1").Range("B").Value &"</p>" & _ ' insert Name from column B
            "<p><strong><u>This is a test email</u></strong></p>"
            .Display
        End With
        On Error GoTo 0
        Set OutMail = Nothing

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

I would like to have data from columns B and C in the email, but I have no idea how to reference them in For each loop and how to put them to the place I want.

Thank you

Answer 1

Try this code : (I changed 3 lines in your code, I marked Them with (X))

 Sub SendEmails()
       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("A").Cells.SpecialCells(xlCellTypeConstants)
            i = cell.Row '(X)
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = "Project" & Sheets("Sheet1").Range("C" & i).Value '(X)
                .HTMLBody = "<p>Hello " & Sheets("Sheet1").Range("B" & i).Value & "</p>" & "<p><strong><u>This is a test email</u></strong></p>" '(X)
                .Display
            End With
            On Error GoTo 0
            Set OutMail = Nothing
       Next cell
       cleanup:
            Set OutApp = Nothing
            Application.ScreenUpdating = True
  End Sub