Generating Automatic Emails For A List With Different Values

[Tuanphun]

I am trying to create something to email folks that have received an error. I have gotten started on the code below but don’t know how to finish. I want the emails to be sent to their email address in column B. In the body of the email I want it to say Hello to their name in column A along with a short email that pulls the error in column C. I have it set to display the emails because I like to look at it before I hit the send button just to make sure. I would also like to just have this layout created so I can change the names and errors. How do I complete this with the code below?

Sub SendEmail_DualComp()

Dim EmailApp As Outlook.Application
Set EmailApp = New Outlook.Application

Dim EmailItem As Outlook.MailItem
Set EmailItem = EmailApp.CreateItem(olMailItem)
Dim SigString As String
Dim Signature, EmailTo, ccTo, subj, msg, Filepath As String
Dim ws As Worksheet
Dim Cel As Range
Dim LR As Long
Dim rng As Range

Set ws = Sheets("Sheet1")


EmailItem.To = ActiveSheet.Range("A1").Value
EmailItem.Subject = "Dual Compensation Audit Results 2021"

EmailItem.Body = "Good Morning," & vbNewLine & vbNewLine & "This is my first email from Excel" & _
vbNewLine & vbNewLine & _
"Thank You," & vbNewLine & vbNewLine & _



EmailItem.Display

On Error GoTo 0
Set Mail = Nothing
Set outApp = Nothing



End Sub

 

[Logit]

Option Explicit

Sub Create_Mail_From_List()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
    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 "?*@?*.?*" Then
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = Cells(cell.Row, "B").Value
                .Body = "Dear " & Cells(cell.Row, "A").Value _
                      & vbNewLine & vbNewLine & _
                        "The following error has been noted : " & Cells(cell.Row, "C").Value
                .Display
                '.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

 

[Tuanphun]

Option Explicit

Sub Create_Mail_From_List()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
    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 "?*@?*.?*" Then
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = Cells(cell.Row, "B").Value
                .Body = "Dear " & Cells(cell.Row, "A").Value _
                      & vbNewLine & vbNewLine & _
                        "The following error has been noted : " & Cells(cell.Row, "C").Value
                .Display
                '.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

Thank you so much for your time. This actually worked amazingly well. I also appreciate the cell check in there to make sure it is an email.

 

[Logit]

Glad to help.