Macro: mail sous condition

Sub mail()
Dim S As Integer, i As Integer
Dim ol As Object
Dim olmail As Object
Dim CurrFile As Object

For i = 6 To [E1000].End(xlUp).Row
If Cells(i, 4) <> "" And Cells(i, 4) <> " " And Cells(i, 6) > Now And Cells(i, 8) <> "" Then

Set ol = CreateObject("Outlook.Application")
Set olmail = ol.CreateItem(0)
    With olmail
        .To = Cells(i, 8)
        .Subject = "Echéance à venir"
        .Body = "Bonjour " & Cells(i, 7) & Chr(13) & Chr(13) & "Votre société " & Cells(i, 5) & " va arriver à terme le " & Cells(i, 6) & "." & Chr(13) & Chr(13) & "Cordialement,"
        'Remplacez .Display par .send pour envoyer directement l'e-mail sans l'afficher dans Outlook
        .Display
        End With
Cells(i, 9) = Now
ElseIf Cells(i, 4) <> "" And Cells(i, 4) <> " " And Cells(i, 6) <= Now And Cells(i, 8) <> "" Then

Set ol = CreateObject("Outlook.Application")
Set olmail = ol.CreateItem(0)
    With olmail
        .To = Cells(i, 8)
        .Subject = "Echéance échue"
        .Body = "Bonjour " & Cells(i, 7) & Chr(13) & Chr(13) & "Votre société " & Cells(i, 5) & " est arrivée à échéance le " & Cells(i, 6) & "." & Chr(13) & Chr(13) & "Cordialement,"
        'Remplacez .Display par .send pour envoyer directement l'e-mail sans l'afficher dans Outlook
        .Display
        End With
Cells(i, 9) = Now
End If
Next i
End Sub