Envoi de mail (CDO) sous condition

Bonjour à tous,

Voici le problème, j'aimerai créer une macro qui analyse les cellules d'une colonne date (Ici toutes les cellules à partir de C2) et envoie ensuite un mail si une condition est respectée.

La condition est que la date doit être inférieure à 2 mois. Les références colonne A, B et C doivent apparaitre dans le corps du mail :

ex:

Bonjour,

Cordialement

Je pense que je ne suis pas loin du but (voir fichier joint) mais mon problème est qu'un mail est envoyé systématiquement même si aucune des dates ne satisfait la condition (Un mail vierge est envoyé dans ce cas), je voudrais qu'aucun mail ne soit envoyé tant que la condition n'est pas remplie.

Je précise que je suis totalement novice en VB, j'ai juste récupéré des bouts de codes de plusieurs site spécialisés pour arriver au résultat actuel qui à mon avis est plus que perfectible !

Merci par avance pour voter aide.

Stéphane.

Bonjour,

ajoute un compteur comme ici (j'ai volontairement ajouté les lignes sans retrait)

Sub EnvoiSmtp()

    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant
    Dim cell As Range
Dim nbr As Integer
nbr = 0

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

        iConf.Load -1
        Set Flds = iConf.Fields
        With Flds
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "***"
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "***"
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "***"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
            .Update
        End With

    With Sheets("Feuil1")
        For Each cell In .Range(.[C2], .[C65536].End(xlUp))
            If cell.Value < DateSerial(Year(Date), Month(Date) + 2, Day(Date)) Then
nbr = nbr + 1
                    strbody = "Bonjour," & vbNewLine & vbNewLine & "Les références ci-dessous arrivent bientôt à échéance :" & vbNewLine & vbNewLine
                    strbody = strbody & cell.Offset(, -2) & ", " & cell.Offset(, -1) & ": " & cell.Value & vbNewLine
                    strbody = strbody & vbNewLine & "Cordialement"
            End If
        Next cell

If nbr > 0 Then
            With iMsg
                Set .Configuration = iConf
                .To = "***@***.fr"
                .CC = ""
                .BCC = ""
                .From = """***"" <***@***.fr>"
                .Subject = "Test Excel"
                .TextBody = strbody
                .Send
            End With
End If

    End With

    Set iMsg = Nothing
    Set iConf = Nothing
    Set Flds = Nothing

End Sub

par ailleurs, je ne suis pas certain que tu ne reçoives pas uniquement le dernier cas !

Super! Merci pour ta réponse, mettre un compteur est effectivement la solution

Regarde aussi si tu as toutes les occurrences dans ton mail, cela me parait bizarre, je ferais bien ceci :

    
With Sheets("Feuil1")
strbody = "Bonjour," & vbNewLine & vbNewLine & "Les références ci-dessous arrivent bientôt à échéance :" & vbNewLine &vbNewLine
For Each cell In .Range(.[C2], .[C65536].End(xlUp))
If cell.Value < DateSerial(Year(Date), Month(Date) + 2, Day(Date)) Then
nbr = nbr + 1
strbody = strbody & cell.Offset(, -2) & ", " & cell.Offset(, -1) & ": " & cell.Value & vbNewLine
End If
Next cell
strbody = strbody & vbNewLine & "Cordialement"

à indenter

Exact, j'ai mal fait mes tests, je ne recevais effectivement que la dernière occurrence. Ton dernier code corrige cela Merci !