Discussion :

[fta95200]

Bonjour,

Je souhaiterais créer une alerte (la plus visuelle possible) afin d'être prévenu dès que je reçois un mail contenant un texte spécifique dans son corps mais uniquement si le mail a été envoyé sur une plage horaire spécifique (si en plus il est possible d'avoir un mix du genre lundi-samedi de 18h à 8h et dimanche toute la journée, ce serait le top ).

Est-ce que vous pouvez m'aider, je suis complètement novice en VBA sous Outlook (j'ai des notions en VBA Excel, mais rien sous Outlook).

Merci,

[fta95200]

Après énormément de recherche sur plein de forums et un mix de tout ce que j'ai pu trouver, j'ai presque (il ne me reste plus qu'à gérer le cas du dimanche, mais je pense avoir une bonne piste) fini.

Pour la partie "mail contenant un texte spécifique dans son corps", je l'ai fais avec les régles Outloook (sujet contenant la chaine de caractère X + le corps du message ne contenant pas la chaine de caractère Y + envoi le mail dans un répertoire Z).

Mon répertoire Z étant nommé : "4 - IT HELPDESK"

Voici le code pour automatiser l'ouverture du mail (cela permet de faire apparaitre Outlook en 1er plan même lorsque la personne est sur autre chose) + une pop-up avec des infos spécifiques (présentes dans le sujet du mail) + sur la plage horaire 18h-8h.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
 
Private Sub Application_NewMail()
    Dim myOlApp As New Outlook.Application
    Dim myNamespace As Outlook.NameSpace
    Dim myInbox As Outlook.Folder
    Dim IncomingTicketsFolder As Outlook.Folder
    Dim myDestFolder As Outlook.Folder
    Dim myItems As Outlook.Items
    Dim myItem As Object
    Dim JrDebNuit As Date
    Dim JrFinNuit As Date
    Dim JrRecEmail As Date
    Dim HrRecEmail
    Dim HrRecEmailTemp As Date
    Dim NouveauSujet As String
    Dim subTemp As Variant
    Dim Ticket
 
    Set myNamespace = myOlApp.GetNamespace("MAPI")
    Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox)         'je récupère ma boite de réception (par défaut)
    Set IncomingTicketsFolder = myInbox.Folders("4 - IT HELPDESK")    'ça c'est le répertoire où mes mails sont envoyés via la règle Outlook
    Set myItems = IncomingTicketsFolder.Items
    Set myDestFolder = myInbox.Folders("temp_VBA")        'le répertoire où je déplace les mails traités (au final je les mettrais certainement à la poubelle
 
    JrDebNuit = VBA.Format(Now - 1, "Short Date")        'la macro est pour une équipe qui travaille la nuit de 18H à 8H, donc on a deux jours sur la vacation
    JrFinNuit = VBA.Format(Now, "Short Date")            'ça c'est le 2ème jour
 
    For Each myItem In IncomingTicketsFolder.Items            'pour chaque mail dans le répertoire
        JrRecEmail = VBA.Format(myItem.ReceivedTime, "Short Date")        'je récupère la date (sans l'heure) d'arrivée du mail
        HrRecEmailTemp = VBA.Format(myItem.ReceivedTime, "HH:nn")       'je récupère l'heure d'arrivée du mail (mais au format am/pm)
        HrRecEmail = Hour(HrRecEmailTemp)            'là je transforme les heures am/pm pour les avoir au format 24h, mais je ne prends que l'heure, pas les minutes
 
        If JrRecEmail = JrFinNuit Then           'si le mail est reçu le jour même
            If HrRecEmail > 17 Or HrRecEmail < 8 Then           'je vérifie que l'heure (format 24h) d'arrivée soit > 17h (j'aurai pu faire >= 18h) ou < 8h
                subTemp = Split(myItem.Subject, ";")         'là c'est personnel, les sujets de mes mails arrivés dans une structure précise avec des infos séparées par ";"
                Ticket = subTemp(3)        'le 3ème "morceau" du sujet du mail m'intéresse (pour l'afficher dans la pop-up), donc je le récupère
                myItem.Move myDestFolder        'je déplace le mail dans la "poubelle" je le fais avant l'affichage sinon le mail se ferme dès que j'acquitte la pop-up
                myItem.Display      'ouvre le mail et permet de forcer l'apparition du msg au 1er plan
                MsgBox ("!!! TICKET A PRENDRE EN COMPTE !!!" & Chr(10) & Chr(10) _                'Chr(10) pour aller à la ligne
                & "N° de Ticket : " & Ticket & Chr(10) _
                & "Date & heure d'arrivée : " & VBA.Format(myItem.ReceivedTime, "dd-mmm-yyyy HH:mm"))
'                NouveauSujet = "!!! MAIL TRAITE !!! " & myItem.Subject            'je modifie le sujet du mail pour indiquer qu'il est traité (peut être inutile, à voir à l'utilisation)
'                myItem.Subject = NouveauSujet        'c'est pour ça que je l'ai mis en commentaire pour l'instant
            End If
        ElseIf JrRecEmail = JrDebNuit Then         'alors là c'est pour sécuriser un max au cas où le mail arriverait à 23:59:59 et que la macro passe à 00:00:01 (ce n'est plus le même jour)
            If HrRecEmail > 18 Then
                subTemp = Split(myItem.Subject, ";")
                Ticket = subTemp(3)
                myItem.Move myDestFolder
                myItem.Display
                MsgBox ("!!! TICKET A PRENDRE EN COMPTE !!!" & Chr(10) & Chr(10) _
                & "N° de Ticket : " & Ticket & Chr(10) _
                & "Date & heure d'arrivée : " & VBA.Format(myItem.ReceivedTime, "dd-mmm-yyyy HH:mm"))
'                NouveauSujet = "!!! MAIL TRAITE !!! " & myItem.Subject
'                myItem.Subject = NouveauSujet
            End If
        End If
        Set myItem = myItems.GetNext           'j'incrémente le mail 
 
    Next myItem        'pour passer au suivant
 
 
'dessous c'est ce que j'ai commencer à récupérer pour traiter le cas du dimanche (où là il faudra prendre la plage horaire complète de la journée)
    'Check if Sunday
'If WkDay = 1 Then
'    SendDate = DateAdd("d", 1, SendDate)
'    SendNow = N
'End If
'
'
'La fonction WeekDay() donne le numéro du jour dans la semaine sachant que le dimanche porte le numéro 1
 
End Sub

Voilà j'espère que ça servira à d'autres personnes

[Oliv-]

Bonsoir,

Je ne comprends pas trop ton process, tu as 2 Traitements l'un par règle pour déplacer le mail et l'autre via l'événement Application_NewMail, pourquoi ne pas utiliser une règle avec l'action exécuter un script ?

Avec cette méthode tu pourras exploiter directement le mail reç sans devoir parcourir tous les emails de ce dossier "4 - IT HELPDESK"


Ensuite attention une MSGBOX bloque tout tant que tu n'as pas cliqué dessus, vaudrait mieux utiliser un USERFORM non modal

[fta95200]

Comme indiqué au début, je suis novice en vba sous outlook
Je vais regardé le truc du vba dans les règles outlook.
Concernant le msgbox, le but est d'obliger la personne a traiter ces mails, d'où le blocage voulu.

[Oliv-]

Salut,


Avec un script lancé par une règle ton code devrait ressembler à cela :

pour tester à partir d'un email ouveret

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
Sub test_Script_HELPDESK_SoirEtWE()
    Dim myItem As Outlook.mailitem
    Set ol = CreateObject("outlook.application")
    Set myItem = ol.ActiveInspector.CurrentItem
    Script_HELPDESK_SoirEtWE myItem
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
 
 
Private Sub Script_HELPDESK_SoirEtWE(myItem As Outlook.mailitem)
    Dim myOlApp As New Outlook.Application
    Dim myNamespace As Outlook.Namespace
    Dim myInbox As Outlook.Folder
    Dim IncomingTicketsFolder As Outlook.Folder
    Dim myDestFolder As Outlook.Folder
 
    Dim JrDebNuit As Date
    Dim JrFinNuit As Date
    Dim JrRecEmail As Date
    Dim HrRecEmail
    Dim HrRecEmailTemp As Date
    Dim NouveauSujet As String
    Dim subTemp As Variant
    Dim Ticket
 
    Set myNamespace = myOlApp.GetNamespace("MAPI")
    Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox)         'je récupère ma boite de réception (par défaut)
    Set IncomingTicketsFolder = myInbox.Folders("4 - IT HELPDESK")    'ça c'est le répertoire où mes mails sont envoyés via la règle Outlook
    Set myDestFolder = myInbox.Folders("temp_VBA")        'le répertoire où je déplace les mails traités (au final je les mettrais certainement à la poubelle
 
    JrDebNuit = VBA.Format(Now - 1, "Short Date")        'la macro est pour une équipe qui travaille la nuit de 18H à 8H, donc on a deux jours sur la vacation
    JrFinNuit = VBA.Format(Now, "Short Date")            'ça c'est le 2ème jour
 
    JrRecEmail = VBA.Format(myItem.ReceivedTime, "Short Date")        'je récupère la date (sans l'heure) d'arrivée du mail
    HrRecEmailTemp = VBA.Format(myItem.ReceivedTime, "HH:nn")       'je récupère l'heure d'arrivée du mail (mais au format am/pm)
    HrRecEmail = Hour(HrRecEmailTemp)            'là je transforme les heures am/pm pour les avoir au format 24h, mais je ne prends que l'heure, pas les minutes
 
    Dim Atraiter As Boolean
 
    If JrRecEmail = JrFinNuit Then           'si le mail est reçu le jour même
        If HrRecEmail > 17 Or HrRecEmail < 8 Then           'je vérifie que l'heure (format 24h) d'arrivée soit > 17h (j'aurai pu faire >= 18h) ou < 8h
            Atraiter = True
        End If
    ElseIf JrRecEmail = JrDebNuit Then         'alors là c'est pour sécuriser un max au cas où le mail arriverait à 23:59:59 et que la macro passe à 00:00:01 (ce n'est plus le même jour)
        If HrRecEmail > 18 Then
            Atraiter = True
        End If
    End If
 
    If DatePart("w", myItem.ReceivedTime, vbSunday) = vbSunday Then
        Atraiter = True
 
    End If
 
    If Atraiter Then
        subTemp = Split(myItem.Subject, ";")
        Ticket = subTemp(3)
        myItem.Move myDestFolder
        myItem.Display
        MsgBox ("!!! TICKET A PRENDRE EN COMPTE !!!" & vbCr & vbCr _
              & "N° de Ticket : " & Ticket & Chr(10) _
              & "Date & heure d'arrivée : " & VBA.Format(myItem.ReceivedTime, "dd-mmm-yyyy HH:mm"))
        '                NouveauSujet = "!!! MAIL TRAITE !!! " & myItem.Subject
        '                myItem.Subject = NouveauSujet
 
    End If
 
 
End Sub

[fta95200]

Bonne optimisation du code
Je suis "un peu" brouillon

Merci !

[fta95200]

Je suis entrain de devenir fou avec l'intégration de la macro dans la règle outlook
J'ai dû modifier la base de registre car avec la nouveau patch de sécurité Outlook, je n'avais plus la possibilité de lancer un script dans les règles Outlook.
Jusque là pas de problème, avec la modification de la base de registre, j'ai bien l'option "Run Script".
Par contre, lorsque je clique sur "Script" pour choisir ma macro, là je n'ai rien
J'ai mis les règles de sécurité au munimum (Enable all macros)
J'ai cherché sur internet, il y a bien le (Item As Outlook.MailItem) dans la macro, et elle est bien dans ThisOutlookSession, donc là je deviens fou.



Est-ce que tu aurais une idée de ce qui pose problème ?

[Oliv-]

OUPS il faut enlever le mot private devant sub

[fta95200]

Mon sauveur !

Merci !