Envoi mail automatique 1 fois par jour

Le 20/07/2020 à 11:12

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 liste 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 2 ème ouverture du fichier dans la journée ça ne renvoie pas de mail répétitif (je ne sais pas si c'est clair)

Voici mon code:

Sub Auto_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 = "seferggtrgtr.fr"
Destinataires2 = "tgrghrhgrthgrth.fr ; grtgtrgrthrthrt.fr ; grtghtrhrhrhtrh.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

Quand la date de la colonne "i" = date du jour --> envoi d'un 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)

Ce qui serait encore plus génial (mais je ne sais pas si c'est réalisable c'est que malgré la date du jour m^me si on ouvre pas le fichier le mail parte quand meme ^^

Ou bien un truc du genre tous les jours le fichier s'ouvre et se ferme pour que le mail s'envoie, car il y a des jour où nous en pensons pas à l'ouvrir et la date passe... ^^"

Enfin un problème à la fois :D

Merci pour votre aide

10suivi-des-reincubations-2020-test-1.zip (178.34 Ko)
Le 20/07/2020 à 12:10

Bonjour,

Ce n'est pas sympa de ne pas avoir temporairement désactivé l'envoi de mail dans ton fichier.

Ce n'est pas sympa non plus de ne pas avoir déprotégé le code dans VBE pour les tests.

Tant qu'à cela ... ne soumet pas de fichier ...

Concernant ta demande ...

Si w1.Cells(i, "I") = D ... cette cellule est forcément différente de vide w1.Cells(i, "I") <> ""

Si elle est différente de vide et quelle doit être égale à D ...

Sur ce .... un essai ...

Je propose donc ... If w1.Cells(i, "I") = D And w1.Cells(i, "N") <> "" Then N étant la cellule où s'inscrit "Email Envoyé"

Sinon, If w1.Cells(i, "I") = D And w1.Cells(i, "I") <> "" And w1.Cells(i, "N") <> "" Then

ric

Le 20/07/2020 à 13:24

Bonjour tout b'abord merci de m'aider

je ne sais pas comment désactiver l’envoi de mail, pour le code pas trop le choix c'est un fichier pour mon boulot donc bon :/

j'ai testé ta solution et malheureusement rien ne se passe, je n'ai plus d'envoi de mail ni la cellule dans la colonne "N" qui se rempli

Le 20/07/2020 à 16:24

Bonjour,

Dans ton fichier colonne i >> est-ce qu'il y a une ou des lignes avec la date d'aujourd'hui ?

Cette ligne ou ces mêmes lignes>> en colonne N > est-ce que les cellules sont vides ?

Si ces deux critères s'avèrent >> ferme le fichier et rouvre-le > le processus courriel va fonctionner et les les cellules concernées en N vont maintenant avoir la mention "Email Envoyé".

Si tu cliques dans ta feuille sur le bouton " ENVOI MAIL " >> ici, ça ne fonctionne pas et étant donné que je n'ai pas accès au code, je ne peux vérifier pourquoi .

Pour que les fichiers ne partent pas >> il faut mettre toute la macro Private Sub Workbook_Open() en commentaire.

Ou bien > tu mets la ligne .Send en commentaire et tu ajoutes la ligne .Display > ainsi le courriel va se rendre dans le gestionnaire de courriel sans être envoyé.

ric

Le 20/07/2020 à 16:42

je te remercie pour c'est éclairage pour évité l'envoi de mail , entre temps j'ai réussi a bidouiller un truc qui me convient pour le moment (plus qu'a voir si il y a possibilité de faire un envoi mail en checkant la date du jour sans ouvrir le fichier ^^)

pour le bouton ENVOI MAIL il va disparaître j'attendais d'avoir l'envoi automatique à l'ouverture du fichier

Voici le code finalisé pour celui où celle qui serait intéressé :)

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 = "fkrefbgeribgerjig.fr"
Destinataires2 = "ferfguibgiebgi.fr ; fiergeigiebgeg.fr ; rofhergeigebri.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") = "Envoyé le " & Format(Now, "DD-MM-YY")
End If
End If
Next i
Application.ScreenUpdating = True
End Sub
12suivi-des-reincubations-2020.zip (227.26 Ko)
Le 20/07/2020 à 17:09

Bonjour,

Si tu n'utiles pas On Error Resume Next > Est-ce que le code fonctionne bien quand même ??

Si oui, ne l'utilise pas. Il est préférables de l'utiliser le moins possible, car cette commande passe outre trop de chose et pourrait poser problème plus loin dans le code.

Si tu es obliger de l'utiliser , ajoute dès que c'est possible dans le code On Error goto 0 afin de contrer cette commande trop permissive.

Les deux conditions > colonne i et N peuvent être aisément sur la même ligne.

Pense à indenter ton code afin qu'il soit plus facile à lire et à y détecter d'éventuelles coquilles.

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 = "fkrefbgeribgerjig.fr"
    Destinataires2 = "ferfguibgiebgi.fr ; fiergeigiebgeg.fr ; rofhergeigebri.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, "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
                .display     ' < pour montrer seulement
 '               .Send        ' < pour envoyé
            End With

            w1.Cells(i, "N") = "Envoyé le " & Format(Now, "DD-MM-YY")
        End If
    Next i
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

ric

Rechercher des sujets similaires à "envoi mail automatique fois jour"