Counting Down the Emails

Sometimes everyone has to do things outside of a database. One of those times, at least for me, was today. Over the past week, I have been getting emails from a SQL Server that has issues – hence why I was called in to check it out.

In my inbox, I had hundreds of emails! What I needed was a count of emails per day from this server.

Problem: Outlook doesn’t do this natively.

Note: if you do some searching of the Internet, you’ll find webpages like this one that tell you to use Outlook Search to do today or yesterday. I need to do days beyond that.

Answer: VBA to the rescue! Yes, you read correctly – VBA!

Sub Countemailsperday()
    Dim objOutlook As Object, 
        objnSpace As Object, 
        objFolder As MAPIFolder
    Dim EmailCount As Integer
    Dim oDate As String
    
    oDate = InputBox("Type the date for count (format m-d-YYYY")
    Set objOutlook = CreateObject("Outlook.Application")
    Set objnSpace = objOutlook.GetNamespace("MAPI")
    On Error Resume Next
    Set objFolder = Application.ActiveExplorer.CurrentFolder
    If Err.Number <> 0 Then
         Err.Clear
         MsgBox "No such folder."
         Exit Sub
    End If
    
    Dim ssitem As MailItem
    Dim dateStr As String
    Dim myItems As Outlook.Items
    Dim dict As Object
    Dim msg As String
    
    Set dict = CreateObject("Scripting.Dictionary")
    Set myItems = objFolder.Items
    myItems.SetColumns ("ReceivedTime")
    ' Determine date of each message:
    For Each myItem In myItems
        dateStr = GetDate(myItem.ReceivedTime)
        If dateStr = oDate Then
            If Not dict.Exists(dateStr) Then
                dict(dateStr) = 0
            End If
            dict(dateStr) = CLng(dict(dateStr)) + 1
        End If
    Next myItem
    ' Output counts per day:
    msg = ""
    For Each o In dict.Keys
        msg = msg & o & ": " & dict(o) & " items" & vbCrLf
    Next
    MsgBox msg
    Set objFolder = Nothing
    Set objnSpace = Nothing
    Set objOutlook = Nothing
End Sub

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

To add it to Outlook, just do the following:

1. Select the folder that you want to count the total incoming emails per day, and then open the Microsoft Visual Basic for Applications by pressing Alt + F11.

2. Then please Insert > Module to insert a new module, and then paste the above VBA code into it.

3. After pasting the VBA code, click the Run button.

4. Then enter the date you want to count the total incoming emails for in the dialog box, and then click OK.

5. In the dialog box that pops-up, you will see the total number of emails for the day.

Hope that everyone out there is working diligently through your database (or sometimes Outlook) issues and we’ll be back with you soon with another great blog post! Until next time my friends!