Excel Macro for automated emails through outlook

[gavstock89]

I have a spreadsheet whereby i want to send an automated email every time I open the file based on a set criteria.

Criteria being -

If column D = "specific text" then send email to column G = "outlook email address" (where the cells in column D and G are in the same row)
Also, once email has been sent, some sort of check so that we don't keep sending the same email every time we reopen the file
I understand I can do this with "hyperlink" formula, but want it automated as soon as spreadsheet is opened.

 

[mumps]

Are you saying that you want the Agreement Ref. in column A in the email body?

 

[gavstock89]

yeah, if possible

 

[mumps]

Try:

Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Dim OutApp As Object, OutMail As Object, srcRng  As Range, status As Range
    Set OutApp = CreateObject("Outlook.Application")
    With ActiveSheet
        .Range("A1").CurrentRegion.AutoFilter 4, "Out of date"
        Set srcRng = .Range("D2", .Range("D" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
        For Each status In srcRng
            If .Range("J" & status.Row) <> "Yes" Then
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .To = status.Offset(, 3).Value
                    .Subject = ""
                    .HTMLBody = Range("A" & status.Row)
                    .Display
                End With
            End If
            .Range("J" & status.Row) = "Yes"
        Next status
        .Range("A1").AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub