[OK]Envoi d'un mail jusqu'à ce que la condition soit remplie

Bonjour,

Je viens m'en remettre à vos bons conseils car je voudrais mettre une condition dans ma macro mais je n'y arrive pas

Ma macro permet de générer automatiquement un mail quand on ouvre Excel lorsque la date de la colonne H (la 8eme) est dépassée.

Mon problème est que ce mail est envoyé tous les jours dès lors que la date est dépassée.

Je souhaiterais que le mail ne soit plus envoyé si dans la colonne I (la 9eme) il est écrit OUI, même si la date est dépassée.

En vous remerciant de votre aide.

Private Sub Workbook_Open()

Dim Ws As Worksheet 'Variable pour affecter le nom de la feuille
Dim DerLig As Long 'Variable pour déterminer la dernière ligne remplie de la colonne H
Dim r As Long 'Variable pour la boucle
Dim Mbody As String 'Variable pour récupérer le texte à mettre dans le corps du message
Dim olApp As Outlook.Application

Set Ws = Sheets("Formation") 
DerLig = Ws.Cells(Columns(8).Cells.Count, 8).End(xlUp).Row 'récupère le N° de la dernière ligne remplie de la colonne H

For r = 2 To DerLig 'Boucle sur toutes les lignes comprises entre la 2 et la dernière remplie
    If Ws.Cells(r, 8) <= Date Then 'Vérifie si le contenu de la cellule est <= que la date du jour
        Mbody = Mbody & " Bonjour, votre formation est périmée  " 
    End If
Next r

Set olApp = CreateObject("outlook.application")

        Dim olMail As Outlook.MailItem
        Set olMail = olApp.CreateItem(olMailItem)

    With olMail

  .To = "XXXXX@gmail.com"
  .CC = "YYYYY@gmail.com"
  .Subject = " Mail automatique : formation périmée "
  .Body = "Bonjour, votre formation est périmée.  "

   .send

    End With

    End Sub

Hello,

J'ai essayé de repondre à ton besoin, mais je propose une autre syntaxe.

Essaye et dis moi si cela fonctionne pour toi?

Sub mail()

Dim Ws As Worksheet 'Variable pour affecter le nom de la feuille
Dim DerLig As Long 'Variable pour déterminer la dernière ligne remplie de la colonne H
Dim r As Long 'Variable pour la boucle
Dim Mbody As String 'Variable pour récupérer le texte à mettre dans le corps du message
Dim olApp As Outlook.Application

Set Ws = ActiveSheet
DerLig = Ws.Cells(Columns(8).Cells.Count, 8).End(xlUp).Row 'récupère le N° de la dernière ligne remplie de la colonne H

For r = 2 To DerLig 'Boucle sur toutes les lignes comprises entre la 2 et la dernière remplie
  If Ws.Cells(r, 9).Value = "oui" Then
  'do nothing
  Else
    If Ws.Cells(r, 8) <= Date Then 'Vérifie si le contenu de la cellule est <= que la date du jour
        Call Mail_small_Text_Outlook
     End If
   End If

Next r

End Sub

Sub Mail_small_Text_Outlook()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2016
    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 & _
              "This is line 1" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"

    On Error Resume Next
    With OutMail
        .To = "xxxxx"
        .CC = ""
        .BCC = ""
        .Subject = "Bonjour, votre formation est périmée."
        .Body = strbody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
         .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

@+

Merci de ton aide, c'est nickel

J'ai fais quelques légères modifs pour répondre à mes besoins