Afficher le nombre de fichier non lu à l'arborescence, et trouver le dossier racine d'un emailItem
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:
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 Sub |
Code:
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 |
Ca 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.
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
Code:
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 |
Sur un autre post, quelqu'un a émis l'hypothèse de passer par un objet avec l'option WithEvents
Alors j'ai déclaré une variable
Code:
Public WithEvents myItem As Outlook.MailItem
et ci dessus avec mon affectation Set myItem = Item, je peux entrer dans cet event
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,
