Statistiques boite mail outlook

Bonjour tous,

Je gère actuellement une boite mail partagée (exchange) dans laquelle nous recevons une masse d'email.

Via des règles (et ma surveillance attentive) tous les emails sont catégorisés en fonction du processus concerné (catégorie rouge, catégorie bleu, catégorie vert, etc) puis une fois traités sont déplacés dans un sous-répertoire "Traité".

Afin de construire mes indicateurs (dans excel) je cherche à récupérer :

- en finalité le nombre d'emails par jour et par catégorie (se trouvant dans le dossier "Traité" de la boite mail)

- ou éventuellement à importer/exporter la liste d'emails dans un tableau excel avec uniquement les champs "date" et "catégorie" et je ferai ma cuisine ensuite

Je précise que j'ai déjà des bases en vba mais avec des données qui sont déjà dans excel. Aussi je ne sais pas si le mieux est d'importer depuis excel ou d'exporter depuis outlook (qui gère aussi le vba).

Est-ce que quelqu'un peu m'orienter ?

Une bonne journée.

Edit 20h... Une fois la tête sortie du guidon ca m'a fait tilt, il fallait attaquer les métadonnées:)

Hello,

Je n'ai pas Outlook pour pouvoir t'aider dans le détail ...

Mais ce code compte le nombre de mails dans inbox par catégories de couleur. Je pense qu'il peut aider dans ton besoin.

Sub CategoriesEmails()

Dim oFolder As MAPIFolder
Dim oDict As Object
Dim sStartDate As String
Dim sEndDate As String
Dim oItems As Outlook.Items
Dim sStr As String
Dim sMsg As String

On Error Resume Next
Set oFolder = Application.ActiveExplorer.CurrentFolder

Set oDict = CreateObject("Scripting.Dictionary")

sStartDate = InputBox("Type the start date (format MM/DD/YYYY)")
sEndDate = InputBox("Type the end date (format MM/DD/YYYY)")

Set oItems = oFolder.Items.Restrict("[Received] >= '" & sStartDate & "' And [Received] <= '" & sEndDate & "'")
oItems.SetColumns ("Categories")

For Each aitem In oItems
sStr = aitem.Categories
If Not oDict.Exists(sStr) Then
oDict(sStr) = 0
End If
oDict(sStr) = CLng(oDict(sStr)) + 1
Next aitem

sMsg = ""
For Each aKey In oDict.Keys
sMsg = sMsg & aKey & ":   " & oDict(aKey) & vbCrLf
Next
MsgBox sMsg

Set oFolder = Nothing

 End Sub