Code:
Sub datesexcelvba()
Dim mydate1 As Date
Dim mydate2 As Long
Dim datetoday1 As Date
Dim datetoday2 As Long
Dim x As Long
lastrow = Sheets("inspection & test plans").Cells(Rows.Count, 1).End(xlUp).Row
For x = 5 To lastrow
mydate1 = Sheets("inspection & test plans").Cells(x, 15).Value
mydate2 = mydate1
Cells(x, 20).Value = mydate2
datetoday1 = Date
datetoday2 = datetoday1
Cells(x, 21).Value = datetoday2
If mydate2 - datetoday2 = 14 Then
Set myApp = New Outlook.Application
Set mymail = myApp.createitem(olmailitem)
mymail.to = Cells(x, 17).Value
With mymail
.Subject = "payment Reminder"
.body = "your cert expires in 14 days"
'.Send
Cells(x, 16) = "Yes"
Cells(x, 16).Interior.ColorIndex = 3
Cells(x, 16).Font.ColorIndex = 2
Cells(x, 19).Value = mydate2 - datetoday2
End If
Next
Set myApp = Nothing
Setmymail = Nothing
End Sub
Comment