Count Outlook emails by Category for a specified date.

JazzSP8

Well-known Member
Joined
Sep 30, 2005
Messages
1,233
Office Version
  1. 365
Platform
  1. Windows
Hey All

I've been asked to come up with way to count emails in various shared mailboxes, by category (person who dealt with them) and for certain dates.

I found this code, https://www.mrexcel.com/forum/excel-questions/660328-count-how-many-emails-each-colour-category.html, which did the trick nicely when it come to the categories (I'll take the time to say "Thanks Domenic!").

I found some more code that counted the emails in an inbox so I tried to merge the two and came up with this;

Code:
Sub CountEmails()
''' Requires Microsoft Outlook Object Library and Microsoft Scripting Runtime to be Enabled

    Dim oDict As Scripting.Dictionary
    Dim olApp As Outlook.Application
    Dim olNS As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim olItem As Object
    Dim arrData() As Variant
    Dim CategoryCnt As Integer
    Dim c As Long
    Dim dateStr, dateChk As String
    
    Set oDict = New Scripting.Dictionary
    Set olApp = New Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    
    Set objFolder = olNS.Folders(Cells(1, "A").Value)
    Set objFolder = objFolder.Folders("Inbox")
    
    Set myItems = objFolder.Items
    myItems.SetColumns ("SentOn")
    
    dateChk = Cells(1, "B").Value
    
    CategoryCnt = olNS.Categories.Count
    
    ReDim arrData(1 To 2, 1 To CategoryCnt)
    
    c = 0
    For Each olItem In objFolder.Items
        dateStr = GetDate(olItem.SentOn)
        
        If dateStr = dateChk Then
        
            If Not oDict.Exists(olItem.Categories) Then
                c = c + 1
                arrData(1, c) = olItem.Categories
                arrData(2, c) = 1
                oDict.Add olItem.Categories, c
            Else
                arrData(2, oDict.Item(olItem.Categories)) = arrData(2, oDict.Item(olItem.Categories)) + 1
            End If
        
        End If
    Next olItem
    
    ReDim Preserve arrData(1 To 2, 1 To c)
    
    Range("A2").Resize(UBound(arrData, 2), UBound(arrData, 1)).Value = Application.Transpose(arrData)
    
End Sub

Function GetDate(dt As Date) As String
    GetDate = Day(dt) & "/" & Month(dt) & "/" & Year(dt)
End Function

The problem seems to occour when the dates match, I verified this with some test code at an earlier point before it triggers. I get a "Subscript out of range" error.

If I comment out the "If dateStr = dateChk Then" and it's "End if" then the code runs and does it's job as it would do without the date check but then I just get the total for each category.

I've tried setting a break point on "If Not oDict.Exists(olItem.Categories) Then" to see if I can find out what the problem is but it just errors out.

Can anyone help?

Thanks
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Are dateStr and dateChk in the same date format?

Try these changes:
Code:
    dateChk = Format(Cells(1, "B").Value, "dd/mm/yyyy")


Function GetDate(dt As Date) As String
    GetDate = Format(dt, "dd/mm/yyyy")
End Function
 
Upvote 0
Yes! That worked! - I hadn't thought to check or force them into the right format because I was getting a match so just assumed they where and got bogged down in other details.

Brilliant, thank you very much for that! :)
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,853
Members
452,361
Latest member
d3ad3y3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top