XL 2019 Envoi de mail automatique sur date à échéance

Phil968

XLDnaute Nouveau
Bonjour à toutes et tous, :)

Sur un classeur à 2 feuilles, je tente avec beaucoup de difficultés à créer en VBA une macro qui me permettrait de recevoir un mail automatiquement +/- 5 jours avant l'échéance d'une date (colonne D).

Je joins un modèle du fichier sur lequel je souhaite appliquer la procédure.

Jusqu'à présent :

Si plusieurs rappels tombent le même jour, un seul s'affiche. Les autres ne partent pas.

Autre souci : lors de l'exécution de la macro, le mail reste en boite d'envoi. Je dois intervenir pour autoriser l'envoi. Le but est que cela se fasse automatiquement.

Je précise que le compte mail renseigné dans la macro sera identique au mail de destination.

Dans le corps du mail, en texte, je souhaiterais faire apparaitre les données des colonnes A et B.

Si quelqu'un pouvait m'orienter un peu, ce serait super sympa. Je patauge. :(
 

Pièces jointes

  • niveaux-et-lasers.xlsm
    22 KB · Affichages: 101

fanch55

XLDnaute Barbatruc
Bonjour,
rajouter ces lignes en fin de votre code d'envoi et ne faites pas de Display avant le Send
VB:
    Set ObjOutlook = CreateObject("Outlook.Application")
        For Each Obj In ObjOutlook.GetNamespace("MAPI").SyncObjects
            Obj.Start
        Next
        ObjOutlook.Quit
    Set ObjOutlook = Nothing
 

Phil968

XLDnaute Nouveau
Bonjour,
Merci pour votre réponse rapide.
En insérant ce code, Outlook se ferme immédiatement.
Je souhaiterais aussi pouvoir définir une seule adresse mail pour tous les envois.
Je suis la seule personne à recevoir les informations. Cela me permettrait de supprimer la colonne ''E''.
Merci.
 

fanch55

XLDnaute Barbatruc
Re,
Indiquez votre mailBox, comme celui-ci est renseigné, vous n'aurez pas à faire un envoi général .
De plus, le code ci-dessous ne fermera pas Outlook s'il est ouvert ...
Code:
Sub Envoyer_Mail_Outlook()
Dim ObjOutlook      As Outlook.Application
Dim ObjMail         As Outlook.MailItem
Dim Nom_Fichier     As String
  
    On Error Resume Next
        Set ObjOutlook = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If ObjOutlook Is Nothing Then
        Set ObjOutlook = New Outlook.Application
        Outlook_Active = False
    Else
        Outlook_Active = True
    End If
    
        Set ObjMail = ObjOutlook.CreateItem(olMailItem)
            '---------------------------------------------------------
            'Exemple pour envoyer un classeur en pièce jointe
            'Nom_Fichier = Application.GetOpenFilename( _
                         "Fichier excel (*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm")
            'If Nom_Fichier = "Faux" Then Exit Sub
            '---------------------------------------------------------
           'Ou bien entrer le path et nom du fichier autrement
            Nom_Fichier = "C:\Chemin\NomFichier.ext"
            If Nom_Fichier = "" Then Exit Sub
           '---------------------------------------------------------
            MailBox = "....@....fr"
        
            For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
                If Date >= Range("D" & 3 + i) And Range("D" & 3 + i) <> "" Then
                    With ObjMail
                   .To = ".....@gmail.com" ' le destinataire
                   .Subject = "Rappel date d'échéance contrôle lasers" ' l'objet du mail
                   .Body = "La date d'échéance du " & Range("D" & 3 + i) & " est arrivée à terme. Merci de faire le nécessaire." 'le corps du mail ..son contenu
                   '.Attachments.Add Nom_Fichier '"C:\Data\essai.txt" ' ou Nomfichier
            '       .Display  '   Ici on peut supprimer pour l'envoyer sans vérification
                   .SendUsingAccount = ObjOutlook.Session.Accounts(MailBox)
                   .Send
                    End With
                End If
            Next i
        Set ObjMail = Nothing
        
        If Not Outlook_Active Then ObjOutlook.Quit
    Set ObjOutlook = Nothing
    
End Sub
 

Phil968

XLDnaute Nouveau
Re,
Merci pour le suivi. :)
Après avoir copié le code, je rencontre une erreur en 1° ligne (voir capture).
Ma version d'Outlook est la 2019. Test effectué avec le logiciel ouvert.
Est-ce là le problème ?
Merci.
 

Pièces jointes

  • Niveaux et lasers.xlsm
    22.8 KB · Affichages: 20
  • Capture d’écran 2021-08-23.png
    Capture d’écran 2021-08-23.png
    56 KB · Affichages: 148

fanch55

XLDnaute Barbatruc
Je suis en excel 2019 mais cela devrait fonctionner en 2016.
J'ai enlevé toute réf aux bibliothèques.
Je n'avais pas testé sur plusieurs envois consécutifs :
Ce code devrait fonctionner ; n'oubliez pas de renseigner l'émetteur et le destinataire ...
Code:
Sub Envoyer_Mail_Outlook()
Dim ObjOutlook      As Object
Dim ObjMail         As Object
Dim Nom_Fichier     As String
 
    On Error Resume Next
        Set ObjOutlook = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If ObjOutlook Is Nothing Then
        Set ObjOutlook = CreateObject("Outlook.Application")
        Outlook_Active = False
    Else
        Outlook_Active = True
    End If
    
        '---------------------------------------------------------
        'Exemple pour envoyer un classeur en pièce jointe
        'Nom_Fichier = Application.GetOpenFilename( _
                     "Fichier excel (*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm")
        'If Nom_Fichier = "Faux" Then Exit Sub
        '---------------------------------------------------------
       'Ou bien entrer le path et nom du fichier autrement
        Nom_Fichier = "C:\Chemin\NomFichier.ext"
        If Nom_Fichier = "" Then Exit Sub
       '---------------------------------------------------------
       Dim oAccount As Object
        MailBox = "xxxx@free.fr"
        Set oAccount = ObjOutlook.Session.currentuser '.Accounts(MailBox)
    
        For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
'        For i = 1 To 7
            If Date >= Range("D" & i) And Range("D" & i) <> "" Then
                Set ObjMail = ObjOutlook.CreateItem(olMailItem)
                With ObjMail
                   .To = "xxxx@gmail.com" ' le destinataire
                   .Subject = "Rappel date d'échéance contrôle lasers" ' l'objet du mail
                   .Body = "La date d'échéance du " & Range("D" & i) & " est arrivée à terme. Merci de faire le nécessaire." 'le corps du mail ..son contenu
                   '.Attachments.Add Nom_Fichier '"C:\Data\essai.txt" ' ou Nomfichier
            '       .Display  '   Ici on peut supprimer pour l'envoyer sans vérification
                   .SendUsingAccount = oAccount
                   .Send
                End With
                Set ObjMail = Nothing
            End If
        Next i
        
        If Not Outlook_Active Then ObjOutlook.Quit
    Set ObjOutlook = Nothing
    
End Sub
 

Phil968

XLDnaute Nouveau
Bonjour,
Le code fonctionne. Mais uniquement sur la feuille active. Ne serait-il pas possible que le code prenne en compte toutes les feuilles du classeur ?
Est-il possible de définir le déclenchement X jours avant l'échéance ?
Serait-il aussi envisageable que le mail créé par le code n'apparaisse pas dans les ''Eléments envoyés'' d'Outlook ?
Un tout grand merci.
 
Dernière édition:

fanch55

XLDnaute Barbatruc
BonSoir,
J'ai une solution pour faire tout ce que vous m'avez demandé,
mais je m'interroge sur le bien-fondé de la démarche .
Pourquoi? parce que mon serveur de messagerie principal a bloqué l'adresse de mon Outlook car il recevait trop de mail de sa part et ce pour un certain temps ...
Je ne voudrai pas que vous vous heurtiez au même problème à moins d'utiliser un serveur autorisant les envois de masse ....
 

Phil968

XLDnaute Nouveau
Bonjour,
La demande se rapportant aux ''Eléments envoyés'' est secondaire, donc facultative.
Mais concernant la prise en considération des 2 (ou plusieurs) feuilles du classeur, ce serait génial.
Ainsi que la possibilité de définir un délai de X jours avant la date d'échéance.
Merci !
 

fanch55

XLDnaute Barbatruc
Bonjour,
le nombre de jours avant échéance est fixé dans le code de Envoyer_Mail_Outlook
Pour envoyer à partir d'une feuille, cliquez sur le bouton "Send".
Pour envoyer toutes les feuilles ( il faut qu'elles aient la même structure ), exécuter la sub Envoyer_tout

Serait-il aussi envisageable que le mail créé par le code n'apparaisse pas dans les ''Eléments envoyés'' d'Outlook ?

Il vaut mieux conserver une trace des envois dans Outlook.
Chaque message est envoyé avec un mot-clé Categories ( fixé à $Rappel dans le code )

Créez un Dossier $Rappel (par exemple)
dans le compte de messagerie.​
1629886219689.png
Créez une Règle​
1629888098992.png
1629888170582.png
Sélectionner le dossier "Éléments Envoyés"
et activer le Tab Dossier

Choisir "Exécuter les règles"
1629888322866.png

Sélectionner la règle.

Exécuter.

Les mails sont déplacés dans le dossier $Rappel
1629888508274.png
 

Pièces jointes

  • niveaux-et-lasers-3.xlsm
    37.4 KB · Affichages: 19

Phil968

XLDnaute Nouveau
Bonjour,
Encore mille mercis pour le suivi et l'excellent tuto fournis :)
Peut-être devrais-je expliquer à quel résultat je souhaitais en arriver en me lançant dans le VBA, mais sans grand succès.
Mon idéal serait :
Que le fichier XLSM une fois placé dans mon ordinateur exécute automatiquement la macro en scannant les dates à échéance de toutes les feuilles du classeur.
Cette action se déroulerait chaque jour à une heure à définir (tâche planifiée).
Un script VBS relié à cette tâche pourrait-il lancer cette macro automatiquement en mode ''silencieux'', ou en fenêtre réduite ?
Merci de vos conseils.
Bien cordialement. :)
 

Phil968

XLDnaute Nouveau
Bonjour,
le nombre de jours avant échéance est fixé dans le code de Envoyer_Mail_Outlook
Pour envoyer à partir d'une feuille, cliquez sur le bouton "Send".
Pour envoyer toutes les feuilles ( il faut qu'elles aient la même structure ), exécuter la sub Envoyer_tout



Il vaut mieux conserver une trace des envois dans Outlook.
Chaque message est envoyé avec un mot-clé Categories ( fixé à $Rappel dans le code )

Créez un Dossier $Rappel (par exemple)
dans le compte de messagerie.​
Regarde la pièce jointe 1113992
Créez une Règle​
Regarde la pièce jointe 1113994Regarde la pièce jointe 1113995
Sélectionner le dossier "Éléments Envoyés"
et activer le Tab Dossier

Choisir "Exécuter les règles"
Regarde la pièce jointe 1113997

Sélectionner la règle.

Exécuter.

Les mails sont déplacés dans le dossier $Rappel
Regarde la pièce jointe 1113998
Bonjour.
J'ai pris le temps de tester ce beau travail. Merci :)
Cependant, le nombre de mails envoyés/reçus ne correspond apparemment pas au nombre de dates échues (en rouge dans les feuilles).
Serait-il possible de faire apparaitre dans le corps du mail à la suite de la date d'échéance, la valeur de la colonne ''A'' ?
Par exemple : "La date d'échéance du 26-11-20 pour le "NIVEAU00" est arrivée à terme."
Est-il aussi envisageable pour des dates d'échéances identiques de les regrouper dans un mail unique (avec le même modèle dans le corps de texte sur différentes lignes bien sur).

Et dernière info, la possibilité de masquer ou non le message signifiant le nombre de mails envoyés ?
J'ai créé un script VBS placé en tâche planifiée. Tout se déroule bien comme souhaité.
Un grand merci pour votre aide et vos précieux conseils ;-)
 

Pièces jointes

  • niveaux-et-lasers-4.xlsm
    31.1 KB · Affichages: 11

Discussions similaires

Réponses
16
Affichages
431
Réponses
17
Affichages
1 K
Réponses
22
Affichages
2 K

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla