Envoi automatique d'une alerte par mail

Bonjour,

totalement novice en macro, je souhaiterai en créer une qui me permettrait d'envoyer automatiquement un mail d'alerte, via Outlook, à une liste de destinataires, lorsque la date inscrite dans une cellule se trouve à 7 jours de la date du jour.

J'ai créé des règles qui en fonction de la date du jour colore la cellule de la date inscrite (voir col.F) : vert si + de 7 jours ; orange à partir de 7 jours et moins ; rouge à partir de la date du jour. Cela n'est pratique que si l'on ouvre et consulte le fichier, mais comme celui-ci n'est pas ouvert tous les jours, une alerte d'échéance par mail serait idéale. Une macro peut-elle effectuer cette tâche sans ouverture du fichier ?

Ce mail devra indiquer que la référence en col.A arrivant à échéance d'ici 7 jours nécessite une action de la part d'un d'un des destinataires. Lorsque cette intervention sera faite, celui-ci mettra son nom et la date en col.G, ce qui devrait avoir pour but d'annuler les règles pour la col.F et remettre la cellule sans remplissage. Je ne sais pas comment faire cette condition (si par une règle ou par une macro).

Sous Windows 10, je n'ai pas fait attention à la Version d'Excel présente sur le PC de mon poste.

J'espère avoir été assez clair et qu'à l'aide du fichier ci-joint quelqu'un aura la gentillesse de m'aider.

Merci d'avance.

Bonjour Trouns,

Pour qu'un mail soit automatiquement envoyé, il est nécessaire qu'une tâche soit active sur ton poste pour réaliser cette fonction.

Alors, je te suggère 2 solutions :

• Si OUTLOOK est systématiquement actif sur ton poste, une macro VBA réalisée dans OUTLOOK (et non dans EXCEL) peut faire le job. Cette macro pouvant s'activer périodiquement (tous les jours, heures,...). Les macros VBA OUTLOOK sont très sensiblement équivalentes à leurs "sœurs" EXCEL.
• Un script VBS à réaliser peut ouvrir ton EXCEL, exécuter la macro VBA EXCEL d'envoi de mail puis fermer l'EXCEL. Ce script serait planifié pour s'exécuter périodiquement. Le langage de script VBS est très proche du langage VBA. Il réclame toutefois quelques connaissances supplémentaires. Le planificateur de tâches WINDOWS est assez simple à mettre en œuvre.

D'autres solutions existent mais réclament d'autres compétences techniques de programmation (powershell, tâches de fond windows,...)

Dis-moi la voie qui te conviens. Je pourrais ensuite t'apporter l'aide nécessaire.

Bonjour Gérard et merci pour ta réponse.

Si l'option via Outlook est, si je comprends bien, un peu plus simple que par Excel, alors allons-y.

Je débute à peine avec le VBA, alors si je dois me plonger dans le VBS... De plus j'ignorais totalement que des macros pouvaient s'effectuer dans Outlook, raison de plus pour découvrir et apprendre.

Je te remercie par avance de ton aide et suis à ta disposition pour tout renseignement complémentaire.

Cordialement, Trouns.

Bonjour Trouns,

Quelques précisions supplémentaires :

- Où sont stockées les adresses mail des destinataires ?

- A quelle fréquence le contrôle des échéances doit se faire ?

- SI un mail de relance a été envoyé, lors du contrôle d'échéance suivant, un nouveau mail doit-il être envoyé lorsqu'aucune action n'a été mentionnée en colonne G?

Bonjour Gérard,

les adresses mails doivent être dans le fichier ?

Je suis désolé, mais je n'ai pas le droit de communiquer des adresses mail internes, il faudra que je les rentre moi-même dans la macro à l'emplacement idoine. Toutefois tu peux te servir de la mienne perso : trouns@gmx.fr

Je souhaiterai que le contrôle des échéances soit quotidien, excepté les week-ends (si cela complique la macro, on peut les laisser), et effectivement un nouveau mail serait nécessaire à chaque contrôle tant qu'aucune action n'a été faite en col.G au regard de la référence concernée.

Vraiment merci pour ton aide.

Cordialement.

Trouns

Bonjour Trouns,

Je te propose de résoudre ton problème de la façon suivante (tu vas sûrement trouver ça un peu compliqué, mais je n'ai pas trouvé plus simple... ) :

1. Dans ton EXCEL, tu ajoutes une plage nommée "Mails" dans laquelle tu indiques les adresses mails des destinataires (je joins le classeur que j'ai utilisé pour mes tests dans lequel j'ai ajouté une feuille "PARAMETRES" contenant cette plage. J'y ai indiqué ton adresse et l'un des miennes - à modifier donc...) .

4. Dans le code VBA OUTLOOK tu choisis le module de classe "ThisOutlookSession"
et tu y colles le code suivant :

Private Sub Application_Reminder(ByVal Item As Object)
    Const cSubject = "RelancerRedacteurs"
    'Si l'objet rendez-vous est celui de la relance des rédacteurs
    If Item.Subject = cSubject Then
        'On exécute la procédure de prévue pour cette relance
        RelanceRedacteurs
    End If
End Sub

5. Toujours dans le code VBA OUTLOOK, tu cliques droit sur "Projet 1..." dans la fenêtre gauche et tu choisis "Insertion" puis "Module" :

6. Dans la fenêtre de code, tu colles intégralement le code suivant :

Option Explicit
Const cWBName = "E:\EXCEL_PRATIQUE\TROUNS\tableau-de-bord.xlsx"             'Nom et chemin complet du classeur "Tableau de bord" -----Chemin à modifier
Const cRange = "F5:F"                                                       'Adresse du début de la plage des cellules à contrôler
Const cSujet = "Action de votre part attendue dans 'tableau-de-bord.xlsx'"  'Sujet du mail--------------------------------------------A adapter
Const cCorps = "L'échéance de la référence XXXXXX est dépassée..."          'Corps du mail--------------------------------------------A adapter
'
Sub RelanceRedacteurs()
    Dim oEXCEL As Object
    Dim oWB As Object
    Dim oSheet As Object
    Dim oRange As Object, oCell As Object

    Dim lLastRow As Long, sRange As String
    Dim sTO As String, sBody As String

    'On créé l'objet "EXCEL"
    Set oEXCEL = CreateObject("Excel.Application")
    'On ouvre le classeur "tableau-de-bord" NE PAS OUBLIER DE MODIFIER LE CHEMIN DE LA CONSTANTE EN DEBUT DE PROCEDURE ------------------
    Set oWB = oEXCEL.Workbooks.Open(cWBName, , True)
    'On affecte la feuille 1 du classeur à une variable-objet locale
    Set oSheet = oWB.Worksheets(1)

    'On recherche la dernière ligne renseignée
    lLastRow = oSheet.Range("F5").End(xlDown).Row
    'On stocke l'adresse de la plage à parcourir dans une variable locale
    sRange = cRange & CStr(lLastRow)
    'On affecte la plage à parcourir
    Set oRange = oSheet.Range(sRange)

    'On parcourt la plage
    For Each oCell In oRange.Cells
        'Pour chaque cellule de la plage
        'Si la date contenue dans la cellule est inférieure ou égale à la date du jour - 7
        If DateDiff("d", Now(), oCell.Value) <= 7 Then
            'Si la cellule de la colonne "G" est vierge
            If IsEmpty(oCell.Offset(, 1).Value) Then
                'On récupère les données nécessaires pour l'envoi du mail
                sTO = oWB.Names("Mails").RefersToRange.Value            'On récupère les adresses de mails présentes dans la plage nommée "Mails"
                sBody = cCorps                                          'On récupère le corps du mail indiqué dans la constante présente en début de module
                sBody = Replace(sBody, "XXXXXX", oCell.Offset(, -5))    'On remplace les XXXXXX avec la référence de la ligne en colonne "A"
                SendAMail sTO, cSujet, sBody                            'On exécute l'envoi du mail par la procédure SendAMail
            End If
        End If
    Next

    'On ferme le classeur sans sauvegarder les modifications
    oWB.Close False

    'On fait le ménage
    Set oWB = Nothing
    oEXCEL.Quit  ' on quitte l'instance EXCEL créée
    Set oEXCEL = Nothing
End Sub
Sub SendAMail(zTO As String, zSubject As String, zBody As String)
    Dim oEmail As MailItem

    'On créé un nouveau mail
    Set oEmail = Application.CreateItem(olMailItem)

    With oEmail
        'On affecte les destinataires
        .To = zTO
        'On affecte une importance haute ----- La ligne peut être supprimée si non nécessaire
        .Importance = olImportanceHigh
        'On affecte l'objet du mail avec la variable passée en paramètre de cette procédure
        .Subject = zSubject
        'On affecte le corps du mail avec la variable passée en paramètre de cette procédure
        .Body = zBody
        'On envoi le mail
        .Send
    End With
    'On fait le ménage
    Set oEmail = Nothing

End Sub

7. Tu modifies les constantes de début de ce module pour répondre à ton besoin :

cWBName = "E:\EXCEL_PRATIQUE\TROUNS\tableau-de-bord.xlsx" 'Nom et chemin complet du classeur "Tableau de bord" -----Chemin à modifier
cSujet = "Action de votre part attendue dans 'tableau-de-bord.xlsx'" 'Sujet du mail--------------------------------------------A adapter
cCorps = "L'échéance de la référence XXXXXX est dépassée..." 'Corps du mail--------------------------------------------A adapter

8. Tu compiles :

, tu enregistres :

, tu quittes le VBA OUTLOOK et, normalement, le tour est joué...

Le code VBA est commenté, mais si tu as des questions, n'hésite pas,

Bonsoir Gérard,

je m'aperçois qu'effectivement l'aide d'un spécialiste s'avérait nécessaire en visualisant ta démonstration.

Je la mets en pratique dès demain matin et ne manquerai pas de t'en donner le résultat.

Encore un grand merci pour le temps et l'implication que tu as consacré à mon problème.

Cordialement,

Trouns.

Bonjour Trouns,

Bon courage et, comme tout ceci peut s'avérer compliqué à comprendre, n'hésite pas à poser tes questions...

Bonjour Gérard,

tout s'est bien passé jusqu'à l'étape 8 où un message d'erreur est apparu lié à la recherche de la dernière ligne renseignée (voir ci-dessous).

A mon faible niveau, je n'ai pas trouvé ce qui pouvait générer cette erreur, sûrement que pour toi ce sera plus évident.

Tu remarqueras également que le chemin d'accès au classeur se trouve sur un serveur, car il est nécessaire que le fichier soit accessible par tous les destinataires du mail de rappel pour être complété. N'est-ce pas gênant pour l'exécution de la macro ?

Merci pour tes conseils, je te souhaite un bon week-end.

Cordialement,

Trouns.

Bonjour Trouns,

Déjà bravo d'être arrivé jusque là

Le problème est dû à un oubli de ma part. Désolé

Pour corriger, ajoute la ligne suivante en tête du module :

Const xlDown = -4121

Ton début de module devrait alors ressembler à :

Ensuite, reprend le process au point 8 : compilation/sauvegarde, ...

Bonjour Gérard,

merci pour ta réponse.

Je teste dès lundi au boulot, car je ne peux pas le faire depuis chez moi (en attente de VPN qui pourrait me permettre de me connecter à distance à l'entreprise).

Je ne manque pas de te faire part du résultat.

Cordialement.

Trouns

Bonjour Gérard,

modification effectuée sans aucun message d'erreur.

J'attends de voir demain matin si mes contacts mails, et moi en copie, recevrons un mail de relance.

Je te tiens au courant.

Merci et bonne journée !

Bonjour Gérard,

malheureusement rien ne se passe.

Aucune alerte n'a été reçue, alors que j'ai mis hier (le 13/04) une référence en date MES (col.F) au 21/04/2021 pour qu'aujourd'hui (14/04/21) un mail soit envoyé aux destinataires prévus (moi y compris).

Je pourrai t'envoyer sur ta boîte mail perso le fichier si tu le souhaites (afin que les adresses mail ne puissent être vues par tous).

A ta disposition pour toute question.

Merci.

Cordialement.

Trouns

Bonjour Trouns,

OK, envoie-moi le projet OUTLOOK en message privé, je regarde ça...

Bonjour Gérard,

Surprise ! Lorsque j'ai voulu te copier le projet OUTLOOK je n'ai trouvé que ça :

J'ai donc recommencé toute la procédure à partir de l'étape 5 avec la ligne que tu m'as fais rajouter (Const xlDown = -4121).

Je m'aperçois cependant que je n'ai pas de Module Relance sous le Module 1, comme dans ton illustration, mais un Module_CONVERSION au dessus (???) :

Je tente de t'envoyer le tout dès demain.

Merci.

Cordialement, Trouns.

Bonjour Trouns,

Je ne vois pas ce qui cloche...

Est-il envisageable que je prenne la main à distance sur ton poste pour tenter de résoudre le problème ?

Bonjour Gérard,

malheureusement ce n'est pas possible, il faudrait un compte administrateur que seul le service informatique possède.

De plus en congés cette semaine, je n'ai pas accès depuis chez moi, faute de VPN, au réseau de l'entreprise et donc au fichier partagé.

Je revérifie tout ça dès lundi et te tiens au courant.

Merci pour ton aide.

Trouns.

Bonjour Gérard,

désolé pour ce long silence, mais des tâches prioritaires au boulot m'ont empêché de consacrer du temps à mon problème.

Je vais tenter une fois de plus de reprendre ton mode opératoire depuis le début afin de voir si le souci ne vient pas d'une mauvaise compréhension de ma part et te tiens au courant.

bonne fin de week-end !

Cordialement

Trouns

Bonjour Gérard,

je viens de trouver du temps à consacrer à mon problème.

J'ai recommencé ton mode opératoire depuis le début et lorsque j'arrive à l'étape 8, j'ai ce message d'erreur :

et cette page s'ouvre (avec la ligne surlignée inhérente au message d'erreur) :

Private Sub CommandButton1_Click()
Dim Resultat As String
'Dim ContactsFolder As Folder
Dim oFolder As MAPIFolder
ReDim usersList(0)
Set olkApp = CreateObject("outlook.application")
Set ContactsFolders = olkApp.Session.GetDefaultFolder(olFolderContacts)

If ListBox1.ListCount = 0 Then
MsgBox ("Aucun contact à modifé")
Exit Sub

Else

answer = MsgBox("Vous voulez appliquer les modifications sur les numéros de téléphones ?", vbExclamation + vbYesNo, "Confirm")
If answer = vbYes Then

Call ExportContactsPST
MsgBox ("La modification des numéros de téléphone des contacts est terminé avec succès vous trouvez le fichier .pst de la sauvegarde des contacts dans le bureau")
Dim oItem
For Each oItem In ContactsFolders.Items.Restrict("[MessageClass]='IPM.Contact'")
Dim oContact As ContactItem
Dim x As String
Dim prenomNom As String
Set oContact = oItem
If Not oContact Is Nothing Then
With oContact
teleNumberAssistant = RemovePrefix(.AssistantTelephoneNumber, usersList, prenomNom)


If (.AssistantTelephoneNumber <> teleNumberAssistant) Then
.AssistantTelephoneNumber = teleNumberAssistant
End If
teleNumberBusiness2 = RemovePrefix(.Business2TelephoneNumber, usersList, prenomNom)


If (.Business2TelephoneNumber <> teleNumberBusiness2) Then
.Business2TelephoneNumber = teleNumberBusiness2
End If

teleNumberBusinessFaxNumber = RemovePrefix(.BusinessFaxNumber, usersList, prenomNom)


If (.BusinessFaxNumber <> teleNumberBusinessFaxNumber) Then
.BusinessFaxNumber = teleNumberBusinessFaxNumber
End If


teleNumberBusinessTelephoneNumber = RemovePrefix(.BusinessTelephoneNumber, usersList, prenomNom)


If (.BusinessTelephoneNumber <> teleNumberBusinessTelephoneNumber) Then
.BusinessTelephoneNumber = teleNumberBusinessTelephoneNumber
End If


teleCallbackTelephoneNumber = RemovePrefix(.CallbackTelephoneNumber, usersList, prenomNom)


If (.CallbackTelephoneNumber <> teleCallbackTelephoneNumber) Then
.CallbackTelephoneNumber = teleCallbackTelephoneNumber
End If

teleCarTelephoneNumber = RemovePrefix(.CarTelephoneNumber, usersList, prenomNom)


If (.CarTelephoneNumber <> CarTelephoneNumber) Then
.CarTelephoneNumber = CarTelephoneNumber
End If


teleCompanyMainTelephoneNumber = RemovePrefix(.CompanyMainTelephoneNumber, usersList, prenomNom)


If (.CompanyMainTelephoneNumber <> teleCompanyMainTelephoneNumber) Then
.CompanyMainTelephoneNumber = teleCompanyMainTelephoneNumber
End If

teleHome2TelephoneNumber = RemovePrefix(.Home2TelephoneNumber, usersList, prenomNom)


If (.Home2TelephoneNumber <> teleHome2TelephoneNumber) Then
.Home2TelephoneNumber = teleHome2TelephoneNumber
End If
teleHomeFaxNumber = RemovePrefix(.HomeFaxNumber, usersList, prenomNom)


If (.HomeFaxNumber <> teleHomeFaxNumber) Then
.HomeFaxNumber = teleHomeFaxNumber
End If

teleHomeTelephoneNumber = RemovePrefix(.HomeTelephoneNumber, usersList, prenomNom)


If (.HomeTelephoneNumber <> teleHomeTelephoneNumber) Then
.HomeTelephoneNumber = teleHomeTelephoneNumber
End If

teleMobileTelephoneNumber = RemovePrefix(.MobileTelephoneNumber, usersList, prenomNom)


If (.MobileTelephoneNumber <> teleMobileTelephoneNumber) Then
.MobileTelephoneNumber = teleMobileTelephoneNumber

End If
teleOtherFaxNumber = RemovePrefix(.OtherFaxNumber, usersList, prenomNom)


If (.OtherFaxNumber <> teleOtherFaxNumber) Then
.OtherFaxNumber = teleOtherFaxNumber
End If

teleOtherTelephoneNumber = RemovePrefix(.OtherTelephoneNumber, usersList, prenomNom)


If (.OtherTelephoneNumber <> teleOtherTelephoneNumber) Then
.OtherTelephoneNumber = teleOtherTelephoneNumber
End If
telePrimaryTelephoneNumber = RemovePrefix(.PrimaryTelephoneNumber, usersList, prenomNom)


If (.PrimaryTelephoneNumber <> telePrimaryTelephoneNumber) Then
.PrimaryTelephoneNumber = telePrimaryTelephoneNumber
End If

teleRadioTelephoneNumber = RemovePrefix(.RadioTelephoneNumber, usersList, prenomNom)


If (.RadioTelephoneNumber <> teleRadioTelephoneNumber) Then
.RadioTelephoneNumber = teleRadioTelephoneNumber
End If


teleTelexNumber = RemovePrefix(.TelexNumber, usersList, prenomNom)


If (.TelexNumber <> teleTelexNumber) Then
.TelexNumber = teleTelexNumber
End If
teleTTYTDDTelephoneNumber = RemovePrefix(.TTYTDDTelephoneNumber, usersList, prenomNom)


If (.TTYTDDTelephoneNumber <> teleTTYTDDTelephoneNumber) Then
.TTYTDDTelephoneNumber = teleTTYTDDTelephoneNumber
End If





.Save

End With
End If
Next

Unload Me
Else
MsgBox "Annulation de la modification des contacts", vbInformation, "Confirm"
Unload Me
End If
End If
End Sub

Ceci peut-il être une réponse au dysfonctionnement de la macro ?

Je ne sais pas si cela peut aider, mais voici une copie écran de ma page :

Encore désolé de monopoliser ton temps sur mon problème qui je te l'avoue commence à me lasser (beaucoup d'énergie et de temps pour une tâche accessoire de mon poste demandés à un tiers).

Merci d'avance.

Cordialement,

Trouns.