Microsoft 365 Envoyer un email automatique a date d'échéance d'une cellule Excel

Abdenour · 7 Avril 2022

Bonjour,

Je ne connais pas du tout le VBA mais je me permets de solliciter votre aide.

Je possède un fichier Excel qui liste les tâches de mes différents projets. Chaque tâche possède un nom de tâche (colonne C), une date de début (colonne I) et une date de fin (colonne K). Attention : certaines tâches peuvent ne pas avoir de date de fin.

Ce qui est souhaité :

1/ C'est d'envoyer un email pour toutes les lignes de mon fichier dont les tâches disposes uniquement d'une date de fin. Si pas de date de fin saisi dans la colonne K, dans ce cas je n'envoi aucun email.

2/ Dans l'email envoyé avoir un titre d'objet ainsi qu'une phrase du type "La tâche xxxx n'est pas finalisé, merci de la traiter au plus vite". Le xxxx doit correspondre au texte saisi en colonne C qui correspond au nom de la tâche.

J'ai réussi a faire quelque chose (ci-dessous) mais cela ne fonctionne pas correctement car d'une part je reçois des emails pour les tâches ne possédant pas de date de fin (cellules vides) et plus d'emails qu'il n'y a de lignes dans mon tableau.

VB:

Sub envoimail()

Dim messagerie As Object
Dim email As Object
Dim cel As Range
Dim delai As Integer

Set messagerie = CreateObject("Outlook.Application")

delai = 1 'jours

For Each cel In Range("A4:A" & Range("A4").End(xlDown).Row)
    If cel.Offset(, 7).Value - Now < delai Then

        Set email = messagerie.CreateItem(0)
    
        With email
            .to = "monadresseemail@toto.fr"
            .Subject = "mettre ici le titre du mail"
            .body = "Bonjour, la tâche " & cel.Offset(, 2) & " arrive à échéance." & vbCrLf & "Merci de la traiter dès que possible." & vbCrLf & "Cordialement"
            
            .ReadReceiptRequested = True
            .display ' à remplacer par .send si ok
        End With

        Set email = Nothing

    End If
Next cel

Set messagerie = Nothing

End Sub

Informations complémentaires : J'utilise Microsoft Office 365 avec dernière version d'Excel.

danielco · 7 Avril 2022

Bonjour,

Essaie :

VB:

Sub EnvoiMail()
    Dim olApp As Object, M As Object, C As Range
    Set olApp = CreateObject("Outlook.application")
    With Sheets("Suivi Projets")
      For Each C In .Range("K6", .Cells(.Rows.Count, 11).End(xlUp))
          If IsNumeric(C) Then
            Set M = olApp.CreateItem(olMailItem)
            M.Subject = "Alerte"
            M.Body = "La tâche " & C.Offset(, -8) & _
              " n'est pas finalisée, merci de la traiter au plus vite"
            M.Recipients.Add "test@test.com"
            M.Send
        End If
      Next C
    End With
End Sub

Daniel

Abdenour · 7 Avril 2022

danielco à dit:

Bonjour,

Essaie :

VB:

Sub EnvoiMail()
    Dim olApp As Object, M As Object, C As Range
    Set olApp = CreateObject("Outlook.application")
    With Sheets("Suivi Projets")
      For Each C In .Range("K6", .Cells(.Rows.Count, 11).End(xlUp))
          If IsNumeric(C) Then
            Set M = olApp.CreateItem(olMailItem)
            M.Subject = "Alerte"
            M.Body = "La tâche " & C.Offset(, -8) & _
              " n'est pas finalisée, merci de la traiter au plus vite"
            M.Recipients.Add "test@test.com"
            M.Send
        End If
      Next C
    End With
End Sub

Daniel

Tout d'abord merci pour ton aide .

Je viens de tester. Ci-dessous mon résultat.

1/ Dans le fichier que j'ai mis en pj de ce post, seule une tâche sur les trois possède une date de fin (la tâche B1). Mais lors de mon test j'ai reçu 3 emails au lieu de 1 seul.

2/ Dans les 3 emails reçus, seulement dans un seul email j'ai le nom de la tâche qui a été reprise. Or je devrais aussi avoir les noms des tâches pour les 2 autres emails même si je ne suis pas censé les recevoir car ils ne possèdent pas de date de fin.

Abdenour · 11 Avril 2022

Une réponse à ma demande svp ?

danielco · 11 Avril 2022

Désolé.

J'avais préparé une réponse... J'ai dû oublier de l'envoyer. J'ai corrigé ainsi :

VB:

Sub EnvoiMail()
    Dim olApp As Object, M As Object, C As Range
    Set olApp = CreateObject("Outlook.application")
    With Sheets("Suivi Projets")
      For Each C In .Range("K6", .Cells(.Rows.Count, 11).End(xlUp))
        If C.Row = 10 Then Stop
        If IsDate(C.Value) Then
          If C > 0 Then
            Set M = olApp.CreateItem(olMailItem)
            M.Subject = "Alerte"
            M.Body = "La tâche " & C.Offset(, -8) & _
              " n'est pas finalisée, merci de la traiter au plus vite"
            M.Recipients.Add "test@test.com"
            M.Send
          End If
        End If
      Next C
    End With
End Sub

Teste.

Daniel

Abdenour · 11 Avril 2022

danielco à dit:

Désolé.

J'avais préparé une réponse... J'ai dû oublier de l'envoyer. J'ai corrigé ainsi :

VB:

Sub EnvoiMail()
    Dim olApp As Object, M As Object, C As Range
    Set olApp = CreateObject("Outlook.application")
    With Sheets("Suivi Projets")
      For Each C In .Range("K6", .Cells(.Rows.Count, 11).End(xlUp))
        If C.Row = 10 Then Stop
        If IsDate(C.Value) Then
          If C > 0 Then
            Set M = olApp.CreateItem(olMailItem)
            M.Subject = "Alerte"
            M.Body = "La tâche " & C.Offset(, -8) & _
              " n'est pas finalisée, merci de la traiter au plus vite"
            M.Recipients.Add "test@test.com"
            M.Send
          End If
        End If
      Next C
    End With
End Sub

Teste.

Daniel

Merci Daniel,

Je viens de tester et j'ai un arrêt sur le visual basic. Voir capture écran en pièce jointe.
La macro ne fonctionne donc pas.

Pour ne pas faire plusieurs allers/retours d'échanges, je tiens à préciser que dans ma colonne K il peut y avoir des cellules sans date de fin (date d'échéance). Et que ce qui est souhaité est d'avoir un email qui sera envoyé en auto par exemple 5 jours avant une date de fin saisi dans une des cellules de la colonne K.

D'avance, je te remercie pour ton aide.

danielco · 11 Avril 2022

Ce n'est pas mon jour. C'est une ligne de test. Supprime-la.

Daniel

Abdenour · 12 Avril 2022

Bonjour Daniel,

Je viens de tester et cela fonctionne parfaitement. Je te remercie.
Une seule chose manquante à cette macro ou plutôt une condition comme demandé dans mon premier post.

Que l'email ne soit envoyé uniquement que 5 jours avant la date de fin (date d'échéance en colonne K).

Si la "date de fin" saisi dans la colonne K est supérieur à 5 jours : Pas d'envoi d'email.
Si la "date de fin" saisi dans la colonne K est inférieur à 5 jours : Envoyer un email.

danielco · 12 Avril 2022

Bonjour,

Sauf erreur, dans ton post initial, il n'est pas question de ça :

1/ C'est d'envoyer un email pour toutes les lignes de mon fichier dont les tâches disposes uniquement d'une date de fin. Si pas de date de fin saisi dans la colonne K, dans ce cas je n'envoi aucun email.

Essaie comme ça :

VB:

Sub EnvoiMail()
    Dim olApp As Object, M As Object, C As Range
    Set olApp = CreateObject("Outlook.application")
    With Sheets("Suivi Projets")
      For Each C In .Range("K6", .Cells(.Rows.Count, 11).End(xlUp))
        If IsDate(C.Value) Then
          If C > 0 Then
            If C - Date < 5 And C > Date Then
              Set M = olApp.CreateItem(olMailItem)
              M.Subject = "Alerte"
              M.Body = "La tâche " & C.Offset(, -8) & _
                " n'est pas finalisée, merci de la traiter au plus vite"
              M.Recipients.Add "test@test.com"
              M.Send
            End If
          End If
        End If
      Next C
    End With
End Sub

Note que tu risques d'envoyer des mails à J-4, J-3, J-2, J-1 et J

Daniel

Abdenour · 12 Avril 2022

danielco à dit:

Bonjour,

Sauf erreur, dans ton post initial, il n'est pas question de ça :

Essaie comme ça :

VB:

Sub EnvoiMail()
    Dim olApp As Object, M As Object, C As Range
    Set olApp = CreateObject("Outlook.application")
    With Sheets("Suivi Projets")
      For Each C In .Range("K6", .Cells(.Rows.Count, 11).End(xlUp))
        If IsDate(C.Value) Then
          If C > 0 Then
            If C - Date < 5 And C > Date Then
              Set M = olApp.CreateItem(olMailItem)
              M.Subject = "Alerte"
              M.Body = "La tâche " & C.Offset(, -8) & _
                " n'est pas finalisée, merci de la traiter au plus vite"
              M.Recipients.Add "test@test.com"
              M.Send
            End If
          End If
        End If
      Next C
    End With
End Sub

Note que tu risques d'envoyer des mails à J-4, J-3, J-2, J-1 et J

Daniel

Abdenour · 12 Avril 2022

Désolé Daniel, tu as raison, je n'avais pas émis cette précision. J'en étais pourtant persuadé

Je viens de tester mais malheureusement aucun email n'est reçu. J'ai pourtant bien modifier l'adresse email par la mienne et mis une date à J-4 avant la date de fin.

danielco · 12 Avril 2022

Avec une date au 131/04 :

Abdenour · 12 Avril 2022

Oui cela fonctionne. Désolé.

Pour terminer 2 questions stp.

1/ Il n'y a pas d'email qui est envoyé quand on est à J. Par contre les emails sont bien envoyés à J-1, J-2, J-3, J-4, J-5. Je souhaiterais aussi inclure dans l'envoi d'email la date du jour (J-0).

2/ Est-il possible que la macro fonctionne même si mon fichier Excel n'est pas ouvert ? Ou bien pour que les alertes puissent d'être envoyées, je dois chaque jour ouvrir le fichier et cliquer sur exécuter la macro ?

Abdenour · 12 Avril 2022

Je crois que j'ai trouvé. J'ai ajouté le signe = dans la ligne ci-dessous. Est-ce bien cela ?

VB:

 If C - Date < 5 And C >= Date Then

danielco · 12 Avril 2022

Si ça te convient, alors oui. Ca signifie que le message sera envoyé le jour d ela date de fin.

Daniel

Microsoft 365 Envoyer un email automatique a date d'échéance d'une cellule Excel

Abdenour

XLDnaute Nouveau

Pièces jointes

danielco

XLDnaute Accro

Abdenour

XLDnaute Nouveau

Abdenour

XLDnaute Nouveau

danielco

XLDnaute Accro

Abdenour

XLDnaute Nouveau

Pièces jointes

danielco

XLDnaute Accro

Abdenour

XLDnaute Nouveau

danielco

XLDnaute Accro

Abdenour

XLDnaute Nouveau

Abdenour

XLDnaute Nouveau

danielco

XLDnaute Accro

Abdenour

XLDnaute Nouveau

Abdenour

XLDnaute Nouveau

danielco

XLDnaute Accro

Discussions similaires