Désolé pour le titre un peu barbare, ce que je souhaite en finalité c'est que suite à la réception de mails, j'applique des règles pour mettre les email dans des sous dossiers. Or je veux que les dossiers parents aient l'informations du nombre de mail non lu
Pour cela, à la réception de nouveau mail, j'exécute une fonction qui parcourt l'ensemble de mes dossiers, et si besoin renomme le dossier
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13 Private Sub Application_NewMail() Dim App As New Outlook.Application Dim Store As Outlook.Store Dim nbTotalNonLu As Long On Error Resume Next 'boucle sur chaque pst de la session Outlook For Each Store In App.Session.Stores nbTotalNonLu = nbNonLu(Store.GetRootFolder) Next End SubCa correspond à mon problème même s'il mériterait d'être plus propre, c'est à dire repérer le dossier dans lequel est insérer le mail pour ne mettre à jour que le dossier racine comprenant ce dossier.
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 Public Function nbNonLu(ByVal Root As Outlook.Folder) As Long Dim Folder As Outlook.Folder 'Initialisation du nombre d'email non lu dans son propre dossier nbNonLu = Root.UnReadItemCount ' Ajouter les non lus de chaque sous dossier If (Root.Folders.Count > 0) Then For Each Folder In Root.Folders ' Changer le paramètrage par défaut pour visibilité olNoItemCount/olShowTotalItemCount/lShowUnreadItemCount If (Folder = "Brouillons" Or Folder = "Boîte d'envoi" Or Folder = "Courrier indésirable") Then 'Pour ces dossiers, j'affiche le nombre d'éléments totals Folder.ShowItemCount = olShowTotalItemCount Else Folder.ShowItemCount = olNoItemCount nbNonLu = nbNonLu + nbNonLu(Folder) End If Next End If On Error Resume Next 'Modification du libellé du dossier (Sil y a des non lu, qu'il a au moins un sous dossier) If (Root.Folders.Count > 0) Then If (nbNonLu > 0) Then If (InStr(1, Root.Name, " (", vbTextCompare)) > 0 Then Root.Name = VBA.Trim(VBA.Left(Root.Name, InStr(1, Root.Name, " (", vbTextCompare))) & " (" & nbNonLu & ") " Else Root.Name = Root.Name & " (" & nbNonLu & ") " End If Else If (InStr(1, Root.Name, " (", vbTextCompare)) > 0 Then Root.Name = VBA.Trim(VBA.Left(Root.Name, InStr(1, Root.Name, " (", vbTextCompare))) End If End If End If End Function
Le problème majeur est à la lecture d'un mail non lu... et donc je dois mettre à jour les libellés des dossiers parents. Pour celà j'ai utilisé cet évènement mais malheureusement je ne peux pas accéder aux propriétés de mon Item à cause de l'erreur suivante : Impossible d'utiliser les propriétés et les méthodes de l'élément dans cette procédure événementielle
Sur un autre post, quelqu'un a émis l'hypothèse de passer par un objet avec l'option WithEvents
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6 Private Sub Application_ItemLoad(ByVal Item As Object) If (TypeName(Item) = "MailItem") Then Set myItem = Item End If End Sub
Alors j'ai déclaré une variable
et ci dessus avec mon affectation Set myItem = Item, je peux entrer dans cet event
Code : Sélectionner tout - Visualiser dans une fenêtre à part Public WithEvents myItem As Outlook.MailItem
Private Sub myItem_ReadComplete(Cancel As Boolean)
MsgBox "Toto"
Dim toto As MailItem
Set toto = myItem
masuperfonction(toto)
End Sub
Et la encore, même erreur, impossible de passer toto ou myItem... toujours la même erreur.
Pour l'instant, je rafraichit l'ensemble de l'arborescence à la lecture d'un mail... c'est très cracra ^^
Si une âme charitable a eu des problématiques identiques, je suis preneur d'une solution. Merci d'avance,
Partager