XL 2016 Envoi mail automatique 1 fois par jour

adel542

XLDnaute Nouveau
Bonjour à tous
Alors voilà j'ai bien avancé dans ma macro mais là je coince ^^

je m'explique:
j'ai une macro qui s’exécute au lancement de mon fichier excel en fonction de la date du jour cela envoi un mail à une lite de personne puis inscrit dans une cellule a coté de la date du jour "mail envoyé". Mon problème, si j'ouvre 5 fois mon fichier dans la journée j'ai 5 fois le mail.... j'aimerai que ça tienne compte de la case "mail envoyé" pour que lors d'une 2eme ouverture du fichier dans la journée ça ne renvoie pas de mail répétitif (je ne sais pas si c'est clair)

VB:
Sub Workbook_Open()
Dim w1 As Worksheet
Dim i As Long
Dim D As Date
Dim M As Object, OlApp As Object, Destinataire As String
Application.ScreenUpdating = False
D = Date
Set w1 = Worksheets("Feuil1")
Destinataires = "aaaaaaaaa.fr"
Destinataires2 = "bbbbbbbbb.fr ; cccccccccc.fr ; ddddddddddd.fr"

Destinataire = Email
For i = 2 To w1.Range("I" & Rows.Count).End(xlUp).Row

On Error Resume Next
If w1.Cells(i, "I") = D And w1.Cells(i, "I") <> "" Then

w1.Cells(i, "N") = "Email Envoyé"
Set OlApp = CreateObject("Outlook.application")
Set M = OlApp.CreateItem(olMailItem)
With M
'Destinataires
.To = Destinataires
'Copie Destinataires
.CC = Destinataires2
.Subject = "sortie de réincubation"
.Body = w1.Cells(i, "A") & "  " & w1.Cells(i, "B") & "  " & w1.Cells(i, "Q") & "  " & w1.Cells(i, "R") & ""
.Recipients.Add Destinataire
.Send
End With
End If
Next i
Application.ScreenUpdating = True
End Sub

Du coup dans mon fichier joint:
quand la date de la colonne "i" correspond à la date du jour, un mail est envoyé et la case de la colonne "n" inscrit (Email Envoyé).
Mais quand je rouvre le fichier ultérieurement dans la journée j'aimerai que ça tienne bien compte du mail déjà envoyé :) pour ne pas le renvoyé de nouveau

Merci d'avance
 

Pièces jointes

  • Suivi Des réincubations 2020.xlsm
    378.5 KB · Affichages: 6
Dernière édition:

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonjour @adel542 , le Forum

Ton Projet VBA est vérouillé par mot de passe dans ton classeur exemple...
Mais bon de toute manière avec le code celà suffit pour te répondre :

VB:
Sub Workbook_Open()
Dim w1 As Worksheet
Dim i As Long
Dim D As Date
Dim M As Object, OlApp As Object, Destinataire As String

Application.ScreenUpdating = False
D = Date
Set w1 = Worksheets("Feuil1")
Destinataires = "aaaaaaaaa.fr"
Destinataires2 = "bbbbbbbbb.fr ; cccccccccc.fr ; ddddddddddd.fr"

Destinataire = Email
For i = 2 To w1.Range("I" & Rows.Count).End(xlUp).Row

        On Error Resume Next
        If w1.Cells(i, "I") = D  Then
            If w1.Cells(i, "N") <> "" Then  ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< AJOUT !!!
                    Set OlApp = CreateObject("Outlook.application")
                    Set M = OlApp.CreateItem(olMailItem)
                        With M
                            'Destinataires
                            .To = Destinataires
                            'Copie Destinataires
                            .CC = Destinataires2
                            .Subject = "sortie de réincubation"
                            .Body = w1.Cells(i, "A") & "  " & w1.Cells(i, "B") & "  " & w1.Cells(i, "Q") & "  " & w1.Cells(i, "R") & ""
                            .Recipients.Add Destinataire
                            .Send
                        End With
                w1.Cells(i, "N") = "Mail Sent " & Format(Now, "DD-MM-YY hh:mm:ss") ' <<<<<<<<<<<<<<<<<<<< AJOUT !!!
            End If
        End If
Next i
Application.ScreenUpdating = True
End Sub

Essaies comme ceci (en partant du principe que c'est bien la Colonne "N" qui est prévue à cet effet !!!

Bonne journée
@+Thierry
 

adel542

XLDnaute Nouveau
Bonjour @adel542 , le Forum

Ton Projet VBA est vérouillé par mot de passe dans ton classeur exemple...
Mais bon de toute manière avec le code celà suffit pour te répondre :

VB:
Sub Workbook_Open()
Dim w1 As Worksheet
Dim i As Long
Dim D As Date
Dim M As Object, OlApp As Object, Destinataire As String

Application.ScreenUpdating = False
D = Date
Set w1 = Worksheets("Feuil1")
Destinataires = "aaaaaaaaa.fr"
Destinataires2 = "bbbbbbbbb.fr ; cccccccccc.fr ; ddddddddddd.fr"

Destinataire = Email
For i = 2 To w1.Range("I" & Rows.Count).End(xlUp).Row

        On Error Resume Next
        If w1.Cells(i, "I") = D  Then
            If w1.Cells(i, "N") <> "" Then  ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< AJOUT !!!
                    Set OlApp = CreateObject("Outlook.application")
                    Set M = OlApp.CreateItem(olMailItem)
                        With M
                            'Destinataires
                            .To = Destinataires
                            'Copie Destinataires
                            .CC = Destinataires2
                            .Subject = "sortie de réincubation"
                            .Body = w1.Cells(i, "A") & "  " & w1.Cells(i, "B") & "  " & w1.Cells(i, "Q") & "  " & w1.Cells(i, "R") & ""
                            .Recipients.Add Destinataire
                            .Send
                        End With
                w1.Cells(i, "N") = "Mail Sent " & Format(Now, "DD-MM-YY hh:mm:ss") ' <<<<<<<<<<<<<<<<<<<< AJOUT !!!
            End If
        End If
Next i
Application.ScreenUpdating = True
End Sub

Essaies comme ceci (en partant du principe que c'est bien la Colonne "N" qui est prévue à cet effet !!!

Bonne journée
@+Thierry

Bonjour

Merci de ta réponse, j'aimerai comprendre ce que tu as fait car cela ne fonctionne pas^^
(j'ai mis le fichier pour que ca donne une idée de ce que je raconte mdr)
je résume : quand la date de la colonne "i" = date du jour --> envoi d'une mail + inscription "Email envoyé" dans la colonne "n"
ce que j'aimerai, c'est qu'une fois le mail + "email envoyé" fait, que si on rouvre le fichier il ne renvoie pas de mail (vu que ce dernier a déjà été envoyé pour la journée
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonsoir @adel542 , le Forum

J'ai bien compris tes deux conditions, et je les ai bien dans mon code en cascAde de IF:

1) If w1.Cells(i, "I") = D Then
2) If w1.Cells(i, "N") <> "" Then ' <<<<<<<<<<<<<<<<<< AJOUT !!!

Cette condition dans ma proposite devrait empêcher l'envoi du mail pour autant qu'à la ligne de la Date du jour, la colonne N soit bien remplie avec quelque chose !
Je ne peux pas tester sur ton classeur, il est vérouillé pour l'accès VBA.

PS: Dans ton Code tu avais fait ceci en un seul IF avec AND :
If w1.Cells(i, "I") = D And w1.Cells(i, "I") <> "" Then
Tu ne regardes pas "N" pour vide .... Et tu écris "Mail Envoyé" avant qu'Outlook n'ait fait son boulot... (On ne sait jamais si il ne répond pas et que ca plante, en plus avec un "Resume Next" sans gestion d'erreur...)

Bonne soirée
@+Thierry

EDIT : 18:15 tu peux toujours essayer de blinder aussi la première condition, mais si le mail part, ce n'est pas la raison,

If CDate(w1.Cells(i, "I")) = D Then
 

adel542

XLDnaute Nouveau
Bonsoir @adel542 , le Forum

J'ai bien compris tes deux conditions, et je les ai bien dans mon code en cascAde de IF:

1) If w1.Cells(i, "I") = D Then
2) If w1.Cells(i, "N") <> "" Then ' <<<<<<<<<<<<<<<<<< AJOUT !!!

Cette condition dans ma proposite devrait empêcher l'envoi du mail pour autant qu'à la ligne de la Date du jour, la colonne N soit bien remplie avec quelque chose !
Je ne peux pas tester sur ton classeur, il est vérouillé pour l'accès VBA.

PS: Dans ton Code tu avais fait ceci en un seul IF avec AND :
If w1.Cells(i, "I") = D And w1.Cells(i, "I") <> "" Then
Tu ne regardes pas "N" pour vide .... Et tu écris "Mail Envoyé" avant qu'Outlook n'ait fait son boulot... (On ne sait jamais si il ne répond pas et que ca plante, en plus avec un "Resume Next" sans gestion d'erreur...)

Bonne soirée
@+Thierry

EDIT : 18:15 tu peux toujours essayer de blinder aussi la première condition, mais si le mail part, ce n'est pas la raison,

If CDate(w1.Cells(i, "I")) = D Then

Bonjour merci de ton aide, mais cela ne fonctionne pas (dsl obliger de laisser ma VBA verrouiller sur le fichier car il y a des adresses mail dessus voici le code
VB:
Sub Workbook_Open()
Dim w1 As Worksheet
Dim i As Long
Dim D As Date
Dim M As Object, OlApp As Object, Destinataire As String

Application.ScreenUpdating = False
D = Date
Set w1 = Worksheets("Feuil1")
Destinataires = "l546645656456.fr"
Destinataires2 = "giguiguifuu.fr ; egerogougu.fr ; ergierugierbg.fr"

Destinataire = Email
For i = 2 To w1.Range("I" & Rows.Count).End(xlUp).Row
 
On Error Resume Next
If w1.Cells(i, "I") = D Then
If w1.Cells(i, "N") <> "" Then
 
Set OlApp = CreateObject("Outlook.application")
Set M = OlApp.CreateItem(olMailItem)

With M
'Destinataires
.To = Destinataires
'Copie Destinataires
.CC = Destinataires2
.Subject = "sortie de réincubation"
.Body = w1.Cells(i, "A") & "  " & w1.Cells(i, "B") & "  " & w1.Cells(i, "Q") & "  " & w1.Cells(i, "R") & ""
.Recipients.Add Destinataire
.Send
End With
w1.Cells(i, "N") = "Mail Sent " & Format(Now, "DD-MM-YY hh:mm:ss")
End If
End If
Next i
Application.ScreenUpdating = True
End Sub
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonjour @adel542 , le Forum

Alors je ne vois pas d'où ça vient, je n'ai pas de client Outlook pour simuler ce code, si quelqu'un du Forum veut bien faire un test en écrivant la Date du jour sur la colonne "I" à partir de la ligne 2 de la feuil1 d'un classeur vierge et mettre (ou ne rien mettre) dans la même ligne colonne "N"...

Merci d'avance pour Adel

Bonne journée
@+Thierry
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Adel, Thierry,
Veuillez excuser cette intrusion intempestive, mais quelque chose m'échappe.
Si j'ai bien compris, à l'ouverture j'envoie mes mails et je mets en colonne N Mail envoyé.
VB:
If w1.Cells(i, "N") <> "" Then
   Envoyez mail
End If
Dans ce code, si en Col N il y a Mail envoyé donc <>"", alors j'envoie le mail.
Où est l'astuce qui m'a échappée ?

Second point, pourquoi ne pas faire avant : Destinataire = Email
Code:
If w1.range("N2") <> "" Then exit sub
S'il apparaît dans N2 Mail envoyé, alors on sort.
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonjour Sylvanu
Oui tu as buen compris, il y a aussi une recherche si on est à la date du jour, aussi.
mais sinon oui c'est ça et c'est fait :
If w1.Cells(i, "N") = "" Then

Oops oui c'est "=" qu'il faut mettre (pas "<>" LoL je ne capte ça que maintenant !!! LoL

@+Thierry
 

adel542

XLDnaute Nouveau
Bonjour Adel, Thierry,
Veuillez excuser cette intrusion intempestive, mais quelque chose m'échappe.
Si j'ai bien compris, à l'ouverture j'envoie mes mails et je mets en colonne N Mail envoyé.
VB:
If w1.Cells(i, "N") <> "" Then
   Envoyez mail
End If
Dans ce code, si en Col N il y a Mail envoyé donc <>"", alors j'envoie le mail.
Où est l'astuce qui m'a échappée ?

Second point, pourquoi ne pas faire avant : Destinataire = Email
Code:
If w1.range("N2") <> "" Then exit sub
S'il apparaît dans N2 Mail envoyé, alors on sort.


Bonjour

merci a vous deux c'est super ça fonctionne :D

un grand merci
 

Discussions similaires

Réponses
7
Affichages
591
Réponses
2
Affichages
657

Statistiques des forums

Discussions
315 096
Messages
2 116 172
Membres
112 676
dernier inscrit
little_b