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




Reply With Quote

Bookmarks