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

[Phil968]

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.

 

[fanch55]

Bonjour,
rajouter ces lignes en fin de votre code d'envoi et ne faites pas de Display avant le Send

    Set ObjOutlook = CreateObject("Outlook.Application")
        For Each Obj In ObjOutlook.GetNamespace("MAPI").SyncObjects
            Obj.Start
        Next
        ObjOutlook.Quit
    Set ObjOutlook = Nothing

 

[Phil968]

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]

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 ...

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]

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.

 

[fanch55]

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 ...

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]

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.

 

[fanch55]

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]

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]

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.​
Créez une Règle​
Sélectionner le dossier "Éléments Envoyés" et activer le Tab Dossier Choisir "Exécuter les règles"​
Sélectionner la règle. Exécuter. Les mails sont déplacés dans le dossier $Rappel​

 

[Phil968]

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]

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 ;-)

 

[fanch55]

Dernière mouture :

 

[Phil968]

Dernière mouture :

Super aboutissement.
Peut-être une toute dernière chose ? L'enregistrement automatique du fichier Excel (suite à l'inscription des dates d'envoi des mails en colonne "E"

 

[fanch55]

Insérez cette ligne avant le Exit_Sub:
ThisWorkbook.Save