Count Email in folder + Subfolders and sorting on category.

[Cicerone123]

Hi,

I would like to be able to pick a folder and then the macro/script goes through the main folder + subfolders and then also e-mails within to check their category and then post a result on how many mails were put on the different categories.


I have found two different scripts that each does a part of what i want but i have not yet been able to integrate them to each other.

• The first scripts goes through the mails in a single folder and sorts them by category with some extra features restricting the date and such.
• The Second script simply counts the mails in one folder and it's sub folders and give a single value of how many items that were found.

 

[Cicerone123]

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