Envoi de mail via Outlook à date atteinte dans cellule Excel

Sub SendEmail()
           
Dim OutApp As Object
Dim OutMail As Object
Dim EmailSubject As String
Dim EmailSendTo As String
Dim MailBody As String
       
Set Rng = Range(Range("C1"), Range("C" & Rows.Count).End(xlUp))
     
For Each cell In Rng
If cell.Value <> "" Then

'Get Due Date
    Dte = cell.Value
   
'Get 2 days away by taking 2 days off cell Dte value
    MailDteNear = DateAdd("d", -2, Dte)
   
'Due date is the cell value
    MailDteDue = Dte
   
'Check 2 days away and send to column D address
    If Date = MailDteNear Then
    mail = True
    EmailSendTo = cell.Offset(0, 1).Value
    End If
   
'Check Due and send to column D & E address
    If Date = MailDteDue Then
    mail = True
    EmailSendTo = cell.Offset(0, 1).Value & "; " & cell.Offset(0, 2).Value
    End If
   
 If mail = True Then
   
'Subject string
    EmailSubject = Range("A1").Value 'Cell A1
   
'Mail Body
    MailBody = cell.Offset(0, -1).Value 'Column B
 
'Send Mail
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(o)
        With OutMail
            .Subject = EmailSubject
            .To = EmailSendTo
            '.bcc
            .Body = MailBody
            .Display
            .send
        End With
 
        Set OutMail = Nothing
        Set OutApp = Nothing
        mail = False
        EmailSendTo = ""
       
 End If
 End If
Next