Macro sending email to outlook when due date approaches

Sub eMail()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList As String
Dim eSubject As String
Dim eBody As String

With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With

Sheets(1).Select
lRow = Cells(Rows.Count, 4).End(xlUp).Row

For i = 2 To lRow

if Cells(i, 3).value ="" then goto Skip
if instr(Cells(i, 3).value,".") =0 then goto Skip

toDate = Replace(Cells(i, 3), ".", "/")
If Left(Cells(i, 5), 4) <> "Mail" And toDate - Date <= 7 Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

toList = Cells(i, 4)
eSubject = "SAE - " & Cells(i, 2) & "- Inquiry Follow UP Required - Due on " & Cells(i, 3)
eBody = "Dear PV Team" & vbCrLf & vbCrLf & "This is a remainder email for follow up required on SAE Inquiry raised on " & Cells(i, 6) & " for SAE -" & Cells(i, 2) & vbCrLf & vbCrLf & "Please update the tracker as required." & vbCrLf & vbCrLf & "Thank you"

On Error Resume Next
With OutMail
.To = toList
.CC = "nicoleb@ibm.com"
.BCC = ""
.Subject = eSubject
.Body = eBody
.bodyformat = 1
.Display
End With

On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Cells(i, 5) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column A"
End If

Skip:

Next i

ActiveWorkbook.Save

With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub