MFC avec échéance et envoie de mail

Bonjour;

Je souhaite créer un tableau qui m'avertirait par mail lorsque je suis à deux mois de mon échéance et qui mettrait ma case en orange et en rouge lorsque le délai est dépassé.

merci par avance

cordialement

Bonjour Fred70794,

Ta messagerie est-elle OUTLOOK?

Bonjour Gerard;

Ma messagerie est bien outlook.

Cordialement

Bonjour Fred70794,

Une proposition en P.J.

Le code :

Option Explicit
Const cDateExpiree = 1 'Valeur pour indiquer que la date est expirée
Const cDateMoins60 = 2 'Valeur pour indiquer que la date est dans moins de 2 mois
Sub scanDates()
    Const cMonTableau = "MonTableau" 'à ajuster avec le nom du tableau

    Const cColText = 1 'numéro relatif de la colonne contenant le texte dans le tableau
    Const cColDate = 2 'numéro relatif de la colonne contenant la date dans le tableau

    Dim oRow As Range, oCell As Range, oTableau As Object
    Dim iState As Integer

    Set oTableau = ThisWorkbook.Worksheets(1).ListObjects(cMonTableau)

    Dim oListRow As Object

    For Each oListRow In oTableau.ListRows
        Set oCell = oListRow.Range.Cells(1, cColDate)
        iState = TestCell(oCell)
        Select Case iState
            Case Is = cDateExpiree
                oCell.Interior.Color = vbRed
                sendMail "Date Expirée", oListRow.Range.Cells(1, cColText) & " : " & Format(oCell.Value, "dd/mm/yyyy") & " expirée!"
            Case Is = cDateMoins60
                oCell.Interior.Color = vbYellow
                sendMail "Date à échéance de moins 2 mois", oListRow.Range.Cells(1, cColText) & " : " & Format(oCell.Value, "dd/mm/yyyy")
            Case Else
        End Select
    Next
End Sub
Function TestCell(zCell As Range) As Integer
    Dim lDiff As Long
    If IsDate(zCell.Value) Then
        lDiff = DateDiff("d", Now(), zCell.Value)
        If lDiff < 0 Then
            TestCell = cDateExpiree
        ElseIf lDiff < 60 Then
            TestCell = cDateMoins60
        End If
    End If
End Function
Sub sendMail(zSubject As String, zBody As String)
    Const cMailAdress = "x@Outlook.com"   ' Adresse d'expédition à ajuster
    Const olMailItem = 0

    Dim oOL As Object
    Dim oMail As Object

    PreparerOutlook oOL

    Set oMail = oOL.CreateItem(olMailItem)
    With oMail
        .To = cMailAdress
        .Subject = zSubject
        .Body = zBody
        '.Send
    End With

    Set oMail = Nothing
    Set oOL = Nothing

End Sub
Private Sub PreparerOutlook(ByRef oOutlook As Object)
'par Excel-Malin.com ( https://excel-malin.com )
'------------------------------------------------------------------------------------------------
'Ce code vérifie si Outlook est prêt à envoyer des emails... Et s'il ne l'est pas, il le prépare.
'------------------------------------------------------------------------------------------------
On Error GoTo PreparerOutlookErreur

On Error Resume Next
    'vérification si Outlook est ouvert
    Set oOutlook = GetObject(, "Outlook.Application")

    If (Err.Number <> 0) Then 'si Outlook n'est pas ouvert, une instance est ouverte
        Err.Clear
        Set oOutlook = CreateObject("Outlook.Application")
    Else    'si Outlook est ouvert, l'instance existante est utilisée
        Set oOutlook = GetObject("Outlook.Application")
        'oOutlook.Visible = True
    End If
    Exit Sub

PreparerOutlookErreur:
    MsgBox "Une erreur est survenue lors de l'exécution de PreparerOutlook()..."
End Sub