VBA nettoyage objets des mails

**c.h.u** · 26/10/2023, 15h23

Bonjour à tous,

Suite au changement (ou à la mise en place) d'un nouvel anti-virus, tous les mails reçus de l'extérieur se voient ajouté le préfixe [EXT] en début d'objet ([EXT] Objet). La première fois ce n'est pas gênant mais après quelques échanges on se retrouve vite avec un [EXT] RE: [EXT] RE: [EXT] Objet. Au delà du fait que ça rend l'identification des mails difficiles, ça complexifie également l'application des règles et les recherches de mail (la fonction mails de cette conversation ne marche plus par exemple).

Je me suis donc penché sur le sujet et j'ai réussi à faire une macro qui nettoie l'objet des mails que j'envoie. J'ai donc voulu m'en inspirer pour également nettoyer les objets des mails que je reçois mais là je bute sur des erreurs du type "Erreur de compilation, La déclaration de la procédure ne correspond pas à la description de l'évènement ou de la procédure du même nom". Mon code est le suivant :

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
 
'Clean subject of incoming mails
'Test adapted from above
 
Private Sub Application_NewMail(ByVal Item As Object, Cancel As Boolean)  'Integer instead of Boolean originaly
    'Dim MailItem As Object
    'Set MailItem = Outlook.MailItem
 
    Item.Subject = Replace(Item.Subject, "RE: ", "")
    Item.Subject = Replace(Item.Subject, "FW: ", "")
    Item.Subject = Replace(Item.Subject, "TR: ", "")
    Item.Subject = Replace(Item.Subject, "SV: ", "")
    Item.Subject = Replace(Item.Subject, "[EXT] ", "")
 
'    If Left(Item.Subject, 4) = "RE: " Then Item.Subject = Right(Item.Subject, Len(Item.Subject) - 4)
'    If Left(Item.Subject, 4) = "TR: " Then Item.Subject = Right(Item.Subject, Len(Item.Subject) - 4)
'    If Left(Item.Subject, 4) = "FW: " Then Item.Subject = Right(Item.Subject, Len(Item.Subject) - 4)
'    If Left(Item.Subject, 4) = "[EXT] " Then Item.Subject = Right(Item.Subject, Len(Item.Subject) - 6)
 
End Sub

Comme vous pouvez le voir, j'ai fait des essais que j'ai gardé en commentaire mais rien n'a fonctionné. N'étant pas un expert dans le domaine, je me disais que l'un d'entre vous a déjà rencontré ce problème ou saura m'indiquer où je me trompe.

Merci d'avance pour votre aide !

CHU

**mromain** · 30/10/2023, 10h51

Bonjour c.h.u, le forum,

Pour capter la réception d'un email, il faut utiliser l'évènement NewMailEx (documentation).
Voici un exemple :

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
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim l_o_item As Object
Dim l_o_mailItem As Outlook.mailItem
 
    Set l_o_item = Application.Session.GetItemFromID(EntryIDCollection)
    If TypeOf l_o_item Is mailItem Then
        Set l_o_mailItem = l_o_item
        With l_o_mailItem
            .Subject = Replace(.Subject, "RE: ", "")
            .Subject = Replace(.Subject, "FW: ", "")
            .Subject = Replace(.Subject, "TR: ", "")
            .Subject = Replace(.Subject, "SV: ", "")
            .Subject = Replace(.Subject, "[EXT] ", "")
            .Save
        End With
    End If
 
    Set l_o_item = Nothing
    Set l_o_mailItem = Nothing
End Sub

A+

**c.h.u** · 30/10/2023, 18h02

Bonjour Mr Romain,

Merci pour le tuyau, j'essaie ça dès demain

Bonne soirée à tous !

**c.h.u** · 31/10/2023, 05h57

Ca a l'air de marcher au top ! Merci !

**c.h.u** · 12/12/2023, 07h11

Bonjour à tous,

Dans la même veine que mon précédent post, est-il possible de nettoyer les objets des mails déjà présents dans les boîtes mails ?

Le code précédent permet de nettoyer l'objet des mails rentrants mais je souhaiterais nettoyer ceux des mails déjà stockés.

Merci d'avance pour votre aide.

Guillaume

**mromain** · 15/12/2023, 09h36

Bonjour c.h.u, le forum,

est-il possible de nettoyer les objets des mails déjà présents dans les boîtes mails ?

La proposition ci-dessous permet de nettoyer les mails présents dans la boite de réception :

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
Public Sub CleanInboxEmails()
Dim l_o_fold As Outlook.Folder
Dim l_o_item As Object
Dim l_o_mailItem As Outlook.mailItem
 
    Set l_o_fold = Application.Session.GetDefaultFolder(olFolderInbox)
    For Each l_o_item In l_o_fold.Items
        If TypeOf l_o_item Is mailItem Then
            Set l_o_mailItem = l_o_item
            With l_o_mailItem
                .Subject = Replace(.Subject, "RE: ", "")
                .Subject = Replace(.Subject, "FW: ", "")
                .Subject = Replace(.Subject, "TR: ", "")
                .Subject = Replace(.Subject, "SV: ", "")
                .Subject = Replace(.Subject, "[EXT] ", "")
                .Save
            End With
        End If
    Next l_o_item
 
    Set l_o_fold = Nothing
    Set l_o_item = Nothing
    Set l_o_mailItem = Nothing
End Sub

S’il faut nettoyer les mails de tous les dossier et sous-dossiers, il faudra retoucher le code.

A+

**c.h.u** · 18/12/2023, 15h41

Merci Mromain !

**c.h.u** · 19/12/2023, 20h15

Bonsoir Mromain,

Petite question, je ne comprends pas car le code que tu m'as donné précédemment pour nettoyer l'objet des mails à l'arrivée marche très bien mais ne marche pas tout le temps (d'où ma précédente question). Aurais-tu une idée d'où ça peut venir ?

Je me permets de remettre tout le code que j'ai dans "ThisOutlookSession"

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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
 
'Option Explicit
 
'Clean subject of mails incoming
'https://www.developpez.net/forums/d2157789/logiciels/microsoft-office/outlook/vba-outlook/vba-nettoyage-objets-mails/
 
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim l_o_item As Object
Dim l_o_mailItem As Outlook.mailItem
 
    Set l_o_item = Application.Session.GetItemFromID(EntryIDCollection)
    If TypeOf l_o_item Is mailItem Then
        Set l_o_mailItem = l_o_item
        With l_o_mailItem
            .Subject = Replace(.Subject, "[EXT] ", "")
            .Subject = Replace(.Subject, "AW: ", "")
            .Subject = Replace(.Subject, "FW: ", "")
            .Subject = Replace(.Subject, "FWD: ", "")
            .Subject = Replace(.Subject, "RE: ", "")
            .Subject = Replace(.Subject, "SV: ", "")
            .Subject = Replace(.Subject, "TR: ", "")
            '
            .Subject = Replace(.Subject, "[EXT]", "")
            .Subject = Replace(.Subject, "AW:", "")
            .Subject = Replace(.Subject, "FW:", "")
            .Subject = Replace(.Subject, "FWD:", "")
            .Subject = Replace(.Subject, "RE:", "")
            .Subject = Replace(.Subject, "SV:", "")
            .Subject = Replace(.Subject, "TR:", "")
            '
            .Subject = Replace(.Subject, "[EXT] ", "")
            .Subject = Replace(.Subject, "AW ", "")
            .Subject = Replace(.Subject, "FW ", "")
            .Subject = Replace(.Subject, "FWD ", "")
            '.Subject = Replace(.Subject, "RE ", "")
            .Subject = Replace(.Subject, "SV ", "")
            .Subject = Replace(.Subject, "TR ", "")
            '
 
            .Subject = Replace(.Subject, "[Ext] ", "")
            .Subject = Replace(.Subject, "Aw: ", "")
            .Subject = Replace(.Subject, "Fw: ", "")
            .Subject = Replace(.Subject, "Fwd: ", "")
            .Subject = Replace(.Subject, "Re: ", "")
            .Subject = Replace(.Subject, "Sv: ", "")
            .Subject = Replace(.Subject, "Tr: ", "")
            '
            .Subject = Replace(.Subject, "[Ext]", "")
            .Subject = Replace(.Subject, "Aw:", "")
            .Subject = Replace(.Subject, "Fw:", "")
            .Subject = Replace(.Subject, "Fwd:", "")
            .Subject = Replace(.Subject, "Re:", "")
            .Subject = Replace(.Subject, "Sv:", "")
            .Subject = Replace(.Subject, "Tr:", "")
            '
            .Subject = Replace(.Subject, "[Ext] ", "")
            .Subject = Replace(.Subject, "Aw ", "")
            .Subject = Replace(.Subject, "Fw ", "")
            .Subject = Replace(.Subject, "Fwd ", "")
            '.Subject = Replace(.Subject, "Re ", "")
            .Subject = Replace(.Subject, "Sv ", "")
            .Subject = Replace(.Subject, "Tr ", "")
            '
            .Save
        End With
    End If
 
    Set l_o_item = Nothing
    Set l_o_mailItem = Nothing
End Sub
 
'Clean subject of mails outgoing
'From https://fr.extendoffice.com/documents/outlook/5120-outlook-remove-subject-prefixes.html
 
Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'
    RemovePrefixOut Item, "AW"
    RemovePrefixOut Item, "FW"
    RemovePrefixOut Item, "FWD"
    RemovePrefixOut Item, "RE"
    RemovePrefixOut Item, "SW"
    RemovePrefixOut Item, "TR"
'
End Sub
 
Function RemovePrefixOut(Item As Object, Str As String)
'
Dim xSubject As String
'
If InStr(Item.Subject, Str) > 0 Then
    xSubject = Replace(Item.Subject, Str & ":", "", vbTextCompare)
    Item.Subject = Trim(xSubject)
    Item.Save
End If
'
End Function

**mromain** · 20/12/2023, 09h22

Bonjour c.h.u, le forum,

Petite question, je ne comprends pas car le code que tu m'as donné précédemment pour nettoyer l'objet des mails à l'arrivée marche très bien mais ne marche pas tout le temps (d'où ma précédente question). Aurais-tu une idée d'où ça peut venir ?

Difficile de répondre comme ça...

Quel est le niveau de sécurité des macros sur ton Outlook ?
Est-ce qu'à chaque démarrage d'Outlook il t'es demandé d'activer les macros ?

Si tel est le cas, peut-être que les macros n'ont pas été activées lors de certaines sessions, et du coup, les mails reçus n'ont pas été traités.

A+

**c.h.u** · 22/12/2023, 13h00

Envoyé par mromain

Bonjour c.h.u, le forum,

Difficile de répondre comme ça...

Quel est le niveau de sécurité des macros sur ton Outlook ?
Est-ce qu'à chaque démarrage d'Outlook il t'es demandé d'activer les macros ?

Si tel est le cas, peut-être que les macros n'ont pas été activées lors de certaines sessions, et du coup, les mails reçus n'ont pas été traités.

A+

Bonjour à tous,

Les macros sont sur notification pour toutes les macros et je les ai signées avec un certificat personnel. D'où mon étonnement.

Est-ce que ça peut être l'option explicite ?

Bonne journée et bonnes fêtes !

CHU

VBA nettoyage objets des mails

VBA Outlook

Discussions similaires

Partager

Partager