Adaptation macro pour envoi mail 15 jours avant expiration du document

Bonjour,

je voudrais adapter ce code afin d'envoyer un mail pour dire que le document expire dans 15 jours.

Merci d'avance.

Cordialement

18mfc.xlsx (10.84 Ko)
 Sub MailOutlook()
        Dim OutApp As Object
        Dim OutMail As Object
        Dim strbody As String

        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        strbody = "Bonjour" & vbNewLine & vbNewLine
        With Sheets("Feuil1")
        For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
        If Date - .Range("D" & i) > 15 Then

        strbody = strbody & vbNewLine & _
                  "l'ordonnance de " & .Range("A" & i) & " " & "arrive à sa fin de validité"
        End If
        Next i
        End With
        On Error Resume Next
        With OutMail
            .to = "machin@gmail.com"
            .CC = ""
            .BCC = ""
            .Subject = "fin de validité de l'ordonnance"
            .Body = strbody
            .Display
        End With
        On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing
    End Sub

bonjour,

je changerais la condition

If Date - .Range("D" & i) > 15 Then

en

If .Range("D" & i) - Date <= 15 Then
Rechercher des sujets similaires à "adaptation macro envoi mail jours expiration document"