XL 2019 Envoi de mail automatique sur date à échéance

    Set ObjOutlook = CreateObject("Outlook.Application")
        For Each Obj In ObjOutlook.GetNamespace("MAPI").SyncObjects
            Obj.Start
        Next
        ObjOutlook.Quit
    Set ObjOutlook = Nothing

Sub Envoyer_Mail_Outlook()
Dim ObjOutlook      As Outlook.Application
Dim ObjMail         As Outlook.MailItem
Dim Nom_Fichier     As String
  
    On Error Resume Next
        Set ObjOutlook = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If ObjOutlook Is Nothing Then
        Set ObjOutlook = New Outlook.Application
        Outlook_Active = False
    Else
        Outlook_Active = True
    End If
    
        Set ObjMail = ObjOutlook.CreateItem(olMailItem)
            '---------------------------------------------------------
            'Exemple pour envoyer un classeur en pièce jointe
            'Nom_Fichier = Application.GetOpenFilename( _
                         "Fichier excel (*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm")
            'If Nom_Fichier = "Faux" Then Exit Sub
            '---------------------------------------------------------
           'Ou bien entrer le path et nom du fichier autrement
            Nom_Fichier = "C:\Chemin\NomFichier.ext"
            If Nom_Fichier = "" Then Exit Sub
           '---------------------------------------------------------
            MailBox = "....@....fr"
        
            For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
                If Date >= Range("D" & 3 + i) And Range("D" & 3 + i) <> "" Then
                    With ObjMail
                   .To = ".....@gmail.com" ' le destinataire
                   .Subject = "Rappel date d'échéance contrôle lasers" ' l'objet du mail
                   .Body = "La date d'échéance du " & Range("D" & 3 + i) & " est arrivée à terme. Merci de faire le nécessaire." 'le corps du mail ..son contenu
                   '.Attachments.Add Nom_Fichier '"C:\Data\essai.txt" ' ou Nomfichier
            '       .Display  '   Ici on peut supprimer pour l'envoyer sans vérification
                   .SendUsingAccount = ObjOutlook.Session.Accounts(MailBox)
                   .Send
                    End With
                End If
            Next i
        Set ObjMail = Nothing
        
        If Not Outlook_Active Then ObjOutlook.Quit
    Set ObjOutlook = Nothing
    
End Sub

Sub Envoyer_Mail_Outlook()
Dim ObjOutlook      As Object
Dim ObjMail         As Object
Dim Nom_Fichier     As String
 
    On Error Resume Next
        Set ObjOutlook = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If ObjOutlook Is Nothing Then
        Set ObjOutlook = CreateObject("Outlook.Application")
        Outlook_Active = False
    Else
        Outlook_Active = True
    End If
    
        '---------------------------------------------------------
        'Exemple pour envoyer un classeur en pièce jointe
        'Nom_Fichier = Application.GetOpenFilename( _
                     "Fichier excel (*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm")
        'If Nom_Fichier = "Faux" Then Exit Sub
        '---------------------------------------------------------
       'Ou bien entrer le path et nom du fichier autrement
        Nom_Fichier = "C:\Chemin\NomFichier.ext"
        If Nom_Fichier = "" Then Exit Sub
       '---------------------------------------------------------
       Dim oAccount As Object
        MailBox = "xxxx@free.fr"
        Set oAccount = ObjOutlook.Session.currentuser '.Accounts(MailBox)
    
        For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
'        For i = 1 To 7
            If Date >= Range("D" & i) And Range("D" & i) <> "" Then
                Set ObjMail = ObjOutlook.CreateItem(olMailItem)
                With ObjMail
                   .To = "xxxx@gmail.com" ' le destinataire
                   .Subject = "Rappel date d'échéance contrôle lasers" ' l'objet du mail
                   .Body = "La date d'échéance du " & Range("D" & i) & " est arrivée à terme. Merci de faire le nécessaire." 'le corps du mail ..son contenu
                   '.Attachments.Add Nom_Fichier '"C:\Data\essai.txt" ' ou Nomfichier
            '       .Display  '   Ici on peut supprimer pour l'envoyer sans vérification
                   .SendUsingAccount = oAccount
                   .Send
                End With
                Set ObjMail = Nothing
            End If
        Next i
        
        If Not Outlook_Active Then ObjOutlook.Quit
    Set ObjOutlook = Nothing
    
End Sub