Auto E-mail For Due Date Reminder Using Outlook

[aju.thomas]

Hi,

please insert a column after column D (OverDue days) and put the formula to updating the overdue days (=TODAY()-D2)

Please find the code.

Option Explicit
Sub email_outlook()
    Dim due_date As Date
    Dim row_cnt As Integer
    Dim outapp, outmail, Mail_body, job As String
    Dim source As Range
    Dim cell As Range
    Set outapp = CreateObject("Outlook.Application")
    Set outmail = outapp.CreateItem(0)
    due_date = Format(Now(), "DD-Mmm-YY")
    Cells(1, 1).AutoFilter Field:=5, Operator:=xlFilterValues, Criteria1:="<=0" 'Array(0, "<=0")
    row_cnt = Cells(1).End(xlDown).Row 'ActiveSheet.UsedRange.Rows.Count
    Mail_body = "Please take notice of the following expiration date(s):"
    Set source = Range("A2:A" & row_cnt).SpecialCells(xlCellTypeVisible)
    For Each cell In source
        job = "Equipment Job " & cell.Value & " expiration date : " & cell.Offset(0, 3).Value & " - " & Abs(cell.Offset(0, 4).Value) & " Overdue days."
        Mail_body = Mail_body & vbNewLine & job
    Next cell
    Mail_body = Mail_body & vbNewLine & "Send at " & Now()

    With outmail
        .to = "test"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = Mail_body
        .Send
    End With
End Sub