greglemoine | Alors déterrage de sujet oblige mais c'est pour la bonne cause (enfin il me semble). Moi aussi j'ai cherché un petit moment cette option dans Outlook... et je ne l'ai pas trouvé.
J'ai donc modifié ce que j'ai pu trouvé pour faire un script qui correspondait à mon besoin, donc je le donne tel quel Sachez juste qu'il ne faut pas mettre de parenthèse dans le nom des dossiers ou sous dossier pour que celui ci fonctionne (vous pouvez éditer pour faire autrement)
Il s'exécute à la réception d'un nouveau mail
J'ai mis une boucle pour paramétrer de sorte qu'il affiche le nombre non lu sauf dans certains dossiers (donc cela pourrait etre supprimé après une première exécution => commenté les affectations de ShowItemCount )
Code :
- 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
- Private 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
|
|