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.
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
Bookmarks