Send email when are date past

Hi Hyperbole,

You could use the following code (taken from Ron De Bruin's site) and adapted for you.

Sub Mail_small_Text_Outlook()
' Is working in Office 2000-2007
    If Range("E1").Value > Range("D1").Value + 30 Or Range("E1").Value = "" Then
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
 
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
 
    strbody = "Please take note you have not responded to the letter sent by " & Range("C1").Value & " as registered in the Letter Register."
 
    On Error Resume Next
    With OutMail
        .To = Range("F1").Value
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = strbody
        '.Send   'or use
        .Display
    End With
    On Error GoTo 0
 
    Set OutMail = Nothing
    Set OutApp = Nothing
Else
End If
End Sub

However since your request states you want this message sent when 1 of 2 conditions is met it will send an email if Col E is blank. Are you sure you want this?

SOS,

To be more precise the conditions should be the today date is more than 30 days than Col D and Col E is blank.

As I am not very well verse with VBA I like to know if the codes you have graciously provided will loop through all the rows so that an email will be sent to each of the recipient if the conditions are met.

Hi Hyperbole,

Try this amended code

Sub Send_Mail()
Dim rng As Range
Dim cel As Range
Dim LastCel As String
Dim szToday As String
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
     
LastCel = Range("D65536").End(xlUp).Address
szToday = Format(Date, "dd/mm/yyyy")

Set rng = Range("D8:" & LastCel)
    For Each cel In rng
        If DateDiff("d", cel, Now) > 30 And cel.Offset(0, 1).Value = "" Then
            Set OutApp = CreateObject("Outlook.Application")
            OutApp.Session.Logon
            Set OutMail = OutApp.CreateItem(0)
                strbody = "Please take note you have not responded to the letter sent by " & Range("C1").Value & " as registered in the Letter Register."
     On Error Resume Next
        With OutMail
            .To = Range("F1").Value
            .CC = ""
            .BCC = ""
            .Subject = "This is the Subject line"
            .Body = strbody
            '.Send   'or use
            .Display
        End With
    On Error GoTo 0
 
    Set OutMail = Nothing
    Set OutApp = Nothing
        Else
        End If
    Next cel
End Sub

Of course that code would have to be placed in the Workbook_Open part of your book. Post back if you need any help in that direction