Count how many emails are in each colour category

[hets]

hi,
I need help with counting how many emails in outlook 2010 are under each category. Category are colours, therefore count how many emails are in red category, blue category, etc. Can this be done using vba? Please help!

 

[Domenic]

First, you'll need to set two references. In the Visual Basic Editor (Alt+F11), select Tools, and then Refences. Then select Microsoft Outlook Object Library and Microsoft Scripting Runtime, and click OK. Then place the following code in a standard module. The code will loop through each item (emails and meetings) within your inbox (you can change the folder, as desired). In the active sheet, the macro will list the categories and corresponding email count, starting at A2...

[FONT=Courier New][COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR]
[COLOR=darkblue]Sub[/COLOR] test()
    [COLOR=darkblue]Dim[/COLOR] oDict [COLOR=darkblue]As[/COLOR] Scripting.Dictionary
    [COLOR=darkblue]Dim[/COLOR] olApp [COLOR=darkblue]As[/COLOR] Outlook.Application
    [COLOR=darkblue]Dim[/COLOR] olNS [COLOR=darkblue]As[/COLOR] Outlook.Namespace
    [COLOR=darkblue]Dim[/COLOR] olFolder [COLOR=darkblue]As[/COLOR] Outlook.MAPIFolder
    [COLOR=darkblue]Dim[/COLOR] olItem [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] arrData() [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] CategoryCnt [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] c [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    [COLOR=darkblue]Set[/COLOR] oDict = [COLOR=darkblue]New[/COLOR] Scripting.Dictionary
    
    [COLOR=darkblue]Set[/COLOR] olApp = [COLOR=darkblue]New[/COLOR] Outlook.Application
    
    [COLOR=darkblue]Set[/COLOR] olNS = olApp.GetNamespace("MAPI")
    
    [COLOR=darkblue]Set[/COLOR] olFolder = olNS.GetDefaultFolder(olFolderInbox)
    
    CategoryCnt = olNS.Categories.Count
    
    [COLOR=darkblue]ReDim[/COLOR] arrData(1 [COLOR=darkblue]To[/COLOR] 2, 1 [COLOR=darkblue]To[/COLOR] CategoryCnt)
    
    c = 0
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] olItem [COLOR=darkblue]In[/COLOR] olFolder.Items
        [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] oDict.Exists(olItem.Categories) [COLOR=darkblue]Then[/COLOR]
            c = c + 1
            arrData(1, c) = olItem.Categories
            arrData(2, c) = 1
            oDict.Add olItem.Categories, c
        [COLOR=darkblue]Else[/COLOR]
            arrData(2, oDict.Item(olItem.Categories)) = arrData(2, oDict.Item(olItem.Categories)) + 1
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] olItem
    
    [COLOR=darkblue]ReDim[/COLOR] [COLOR=darkblue]Preserve[/COLOR] arrData(1 To 2, 1 To c)
    
    Range("A2").Resize(UBound(arrData, 2), UBound(arrData, 1)).Value = Application.Transpose(arrData)
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
[/FONT]

 

[hets]

Thank you for your help. I tried the above code but got an error msg on Set oDict = New Scripting.Dictionary, Compile error: User-defined type not defined. How can I change that to make it work?

 

[hets]

When you say 'place the following code in a standard module', how should I do that?

 

[hets]

I realised I was using the code in excel, instead of outlook. But now I get an error msg sayin : Compile error: Sub or function not defined for Range("A2").Resize(UBound(arrData, 2), UBound(arrData, 1)).Value = Application.Transpose(arrData). How can I correct that?

 

[Domenic]

The code that I offered was meant to run from Excel, and places the results in the active worksheet of an opened workbook. If you want to run the code from Outlook, you'll need to specify where you'd like to return the results. Otherwise, to run it from Excel, you'll need to make sure that you set a reference for two libraries, as follows...

Visual Basic Editor (Alt+F11) > Tools > References

Select Microsoft Outlook Object Library 

Select Microsoft Scripting Runtime

Click OK

Exit the Visual Basic Editor (Alt+Q)

And, you'll need to place the code in a standard module...

Press Alt+F11

Select Insert > Module

Copy/paste the code in the module

Press Alt+Q

 

[hets]

Thank you so much.

 

[Domenic]

You're very welcome!