Outlook Category Checker


 

I’ve found several interesting Outlook questions on Twitter recently, including this one from Carl Knecht.

In short, Carl wants a way to discover which Outlook categories he’s not using (i.e. no items assigned to the category) so he can delete them. Outlook isn’t able to do this natively, so once again we have to turn to scripting. To do this, the script first reads the categories from the master category list into an array that will keep track of how many times each category has been used. It then reads through every folder (mailbox and PST files alike) and sub-folder. For each item in each folder, the script checks to see if the item is assigned to one or more categories and updates the counts in the array accordingly. The result is a sorted list of category names and the number of items assigned to each.

Outlook doesn’t have a good mechanism for displaying the results, so I opted to use a macro enabled Excel spreadsheet. Here’s what the output looks like.

Outlook Category Checker output

Each time Carl opens the spreadsheet it will prompt him to update the information. If he opts to update, then the macro will run and refresh the data. How long it will take to do that depends on how many folders Carl has and how many items are in each folder. When updating, the macro displays the update status (i.e. the name of the folder it’s currently working on) on the status bar at the bottom of the workbook window, just below the worksheet.

This solution will only work for Outlook 2007 and later. Outlook used a completely different approach to categories prior to Outlook 2007.

Download the workbook

For anyone who wants to see the code without having to download and open the workbook, here it is. This code would go in the ThisWorkbook module.

Private dicCategories As Object

Sub SearchCategories()
    Dim olkApp As Object, _
        olkSes As Object, _
        olkCategories As Object, _
        olkCategory As Object, _
        olkStore As Object, _
        excRng As Excel.Range, _
        arrKey As Variant, _
        arrVal As Variant, _
        intCnt As Integer, _
        lngRow As Long
    Application.StatusBar = True
    Application.StatusBar = "Processing"
    Set dicCategories = CreateObject("Scripting.Dictionary")
    Set olkApp = CreateObject("Outlook.Application")
    Set olkSes = olkApp.GetNameSpace("MAPI")
    olkSes.Logon olkApp.DefaultProfileName
    Set olkCategories = olkSes.Categories
    For Each olkCategory In olkCategories
        dicCategories.Add olkCategory.Name, 0
    Next
    For Each olkStore In olkSes.Stores
        ProcessFolder olkStore.GetRootFolder
    Next
    arrKey = dicCategories.Keys
    arrVal = dicCategories.Items
    lngRow = 2
    Set excWks = Application.ActiveSheet
    With excWks
        Set excRng = .Range("A1", "B" & .UsedRange.Rows.Count)
        excRng.Delete
        .Cells(1, 1) = "Category"
        .Cells(1, 2) = "Count"
        For intCnt = LBound(arrKey) To UBound(arrKey)
            .Cells(lngRow, 1) = arrKey(intCnt)
            .Cells(lngRow, 2) = arrVal(intCnt)
            lngRow = lngRow + 1
        Next
        .Columns("A:B").AutoFit
        Set excRng = .Range("A1", "B" & lngRow)
        excRng.Sort Key1:="Count", Order1:=xlDescending, Key2:="Category", Order2:=xlAscending, Header:=xlYes
    End With
    Set dicCategories = Nothing
    Set olkCategories = Nothing
    Set olkCategory = Nothing
    Set olkStore = Nothing
    olkSes.Logoff
    Set olkSes = Nothing
    Set olkApp = Nothing
    Application.StatusBar = "Finished"
    Application.StatusBar = False
End Sub

Private Sub ProcessFolder(olkFld As Object)
    Dim olkItm As Object, olkSub As Object, arrCategories As Variant, varCategory As Variant
    Application.StatusBar = "Processing: " & olkFld.Name
    For Each olkItm In olkFld.Items
        If olkItm.Categories <> "" Then
            arrCategories = Split(olkItm.Categories, ",")
            For Each varCategory In arrCategories
                If dicCategories.Exists(varCategory) Then
                    dicCategories.Item(varCategory) = dicCategories.Item(varCategory) + 1
                End If
            Next
        End If
    Next
    For Each olkSub In olkFld.Folders
        ProcessFolder olkSub
    Next
    Set olkItm = Nothing
    Set olkSub = Nothing
End Sub

Private Sub Workbook_Open()
    If MsgBox("Do you want me to update the information now?", vbYesNo, "Update Workbook") = vbYes Then
        SearchCategories
    End If
End Sub

Revisions.

Revision 1.

Carl tested the original version and immediately ran into a problem. It turns out that Carl doesn’t have access to all the public folders in his organization. When the code tries to process a folder that Carl doesn’t have permission to access, it generates a fatal error. One solution to that problem would be to add a command to the code that would tell it to ignore errors. Rather than turn off error processing, I opted to create a version that allows Carl to pick which message stores he wants to process. On opening the workbook Carl will now see two worksheets: Stores and Categories. Carl will start by going to the Stores page and clicking the Update button. This runs a script that populates the worksheet with the names of all the message stores in Outlook. Next, Carl will place a character, any non-blank character will do, in the “Sel” column next to the name of each store he wants to process. With the information stores selected, Carl will switch to the Categories sheet and click the Update button he’ll find there. This triggers the script from the original version that counts the number of times each category is used, only now it will only check the information stores Carl checked on the Stores page.

Download the revised workbook

As with the original version, the code is already in the workbook. I’m showing the code here in case anyone wants to see how I did this without having to download and open the workbook.

Private dicCategories As Object

Sub GetStores()
    Dim excWks As Excel.Worksheet, excRng As Excel.Range, olkApp As Object, olkSes As Object, olkSto As Object, lngRow As Long
    Set excWks = Application.ActiveWorkbook.Worksheets("Stores")
    With excWks
        Set excRng = .Range("A1", "B" & .UsedRange.Rows.Count)
        excRng.Clear
        .Cells(1, 1) = "Sel"
        .Cells(1, 2) = "Store"
    End With
    Set olkApp = CreateObject("Outlook.Application")
    Set olkSes = olkApp.GetNameSpace("MAPI")
    olkSes.Logon olkApp.DefaultProfileName
    lngRow = 2
    For Each olkSto In olkSes.Stores
        excWks.Cells(lngRow, 2) = olkSto.DisplayName
        lngRow = lngRow + 1
    Next
    Set olkSto = Nothing
    olkSes.Logoff
    Set olkSes = Nothing
    Set olkApp = Nothing
    Set excWks = Nothing
End Sub

Sub CheckCategories()
    Dim olkApp As Object, _
        olkSes As Object, _
        olkCategories As Object, _
        olkCategory As Object, _
        olkStore As Object, _
        excCat As Excel.Worksheet, _
        excSto As Excel.Worksheet, _
        excRng As Excel.Range, _
        arrKey As Variant, _
        arrVal As Variant, _
        intCnt As Integer, _
        lngCat As Long, _
        lngSto As Long
    Application.StatusBar = True
    Application.StatusBar = "Processing"
    Set dicCategories = CreateObject("Scripting.Dictionary")
    Set olkApp = CreateObject("Outlook.Application")
    Set olkSes = olkApp.GetNameSpace("MAPI")
    olkSes.Logon olkApp.DefaultProfileName
    Set olkCategories = olkSes.Categories
    For Each olkCategory In olkCategories
        dicCategories.Add olkCategory.Name, 0
    Next
    Set excSto = Application.ActiveWorkbook.Worksheets("Stores")
    For lngSto = 2 To excSto.UsedRange.Rows.Count
        If excSto.Cells(lngSto, 1) <> "" Then
            Set olkStore = olkSes.Stores.Item(excSto.Cells(lngSto, 2).Value)
            ProcessFolder olkStore.GetRootFolder
        End If
    Next
    arrKey = dicCategories.Keys
    arrVal = dicCategories.Items
    lngCat = 2
    Set excCat = Application.ActiveWorkbook.Worksheets("Categories")
    With excCat
        Set excRng = .Range("A1", "B" & .UsedRange.Rows.Count)
        excRng.Clear
        .Cells(1, 1) = "Category"
        .Cells(1, 2) = "Count"
        For intCnt = LBound(arrKey) To UBound(arrKey)
            .Cells(lngCat, 1) = arrKey(intCnt)
            .Cells(lngCat, 2) = arrVal(intCnt)
            lngCat = lngCat + 1
        Next
        .Columns("A:B").AutoFit
        Set excRng = .Range("A1", "B" & lngCat)
        excRng.Sort Key1:="Count", Order1:=xlDescending, Key2:="Category", Order2:=xlAscending, Header:=xlYes
    End With
    Set dicCategories = Nothing
    Set olkCategories = Nothing
    Set olkCategory = Nothing
    Set olkStore = Nothing
    olkSes.Logoff
    Set olkSes = Nothing
    Set olkApp = Nothing
    Application.StatusBar = "Finished"
    Application.StatusBar = False
End Sub

Private Sub ProcessFolder(olkFld As Object)
    Dim olkItm As Object, olkSub As Object, arrCategories As Variant, varCategory As Variant
    Application.StatusBar = "Processing: " & olkFld.Name
    For Each olkItm In olkFld.Items
        If olkItm.Categories <> "" Then
            arrCategories = Split(olkItm.Categories, ",")
            For Each varCategory In arrCategories
                If dicCategories.Exists(varCategory) Then
                    dicCategories.Item(varCategory) = dicCategories.Item(varCategory) + 1
                End If
            Next
        End If
    Next
    For Each olkSub In olkFld.Folders
        ProcessFolder olkSub
    Next
    Set olkItm = Nothing
    Set olkSub = Nothing
End Sub
Advertisements

6 comments on “Outlook Category Checker

  1. If selecting one store at time, I can combine the data afterwards and get what I need. If selecting a list of stores to pass to the macro, I’d need to understand how exactly to do that. Ultimately, whatever option is easier for you to do would be just fine by me.

    • Carl,

      I’ve added a revision that addresses the problem you encountered. Please give it a try and let me know if it works for you.

    • David, you are an amazing man! The revised code/spreadsheet worked like a charm. Thank you very much! For the record, a full 1/3 of my categories were not in use, which is in line with what I was expecting.

    • Thanks, Carl. That’s very generous of you. I’m glad the solution proved useful.

      I was thinking about this solution last night and realized that I could, and should, have added one more feature: the ability to delete unused categories with a single click. That would save you the trouble of having to open Outlook and delete them manually. This morning I added that feature and updated the workbook. If you download the version you’ll find that I’ve added a new column, called “Sel”, and a button titled “Delete” on the Categories page. Once you’ve updated the categories, select the ones you want to delete by entering any character in the “Sel” column for that entry. Once you have the ones you no longer want selected, click the Delete button and the solution will delete them for you.

  2. I appreciate the work. When running the macro I got a Run-time error ‘-1638395 (ffe70005)’: Automation error. I figured out, based on the Processing: information I’m seeing in the Status Bar, that it was trying to hit my work’s Public Folders (yes, we still have them). Some of those folders are secured so I don’t have access to them. The irony of security preventing access to Public Folders wasn’t lost on my, so I went completely offline (disconnected network cable, no Wifi) and I got slammed with Exchange server not available. So is there are way to limit olkStore to exclude Public Folders and/or select the datastores to search in? I fear what the macro may do when it hits the SharePoint Lists datastore, which I also have.

    • Hi, Carl.

      I can modify the solution in a couple of different ways. One approach is to have you select a store (e.g. your mailbox, a personal folder) and have the code process just the folders in that one store. There’s no way I know of to select multiple stores at once, so the second alternative would be for you to pass a list of data stores to the macro. It would then process each store in the list. Which approach do you prefer?

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s