Email Statistics

Copy the code below into your Outlook VBA module (Alt+F11). Connect to a macro button on the ribbon if you use it regularly.


'=================================================================
'                        Email Statistics
'=================================================================
' Export inbox sender, received time, response type and response time to excel for analysis.

Sub GetMailStats()
    Dim oMail As Object    
    Set oFolder = Application.Session.GetDefaultFolder(olFolderInbox)
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set a = fs.CreateTextFile("c:\temp\stats.csv", True)
    
    ' Headers
    a.WriteLine "Sender,ReceivedTime,Response,ResponseTime"
    
    ' Look through each mail item
    For Each oMail In oFolder.Items
        If oMail.Class = olMail And TypeName(oMail) = "MailItem" Then
            a.WriteLine Replace(oMail.Sender, ",", ";") & "," & _
                oMail.ReceivedTime & "," & GetLastVerb(oMail)
        End If
    Next
    a.Close
    
    ' Load excel to view comma seperated values file
    Shell "C:\Program Files (x86)\Microsoft Office\Office14\excel.exe c:\temp\stats.csv", vbMaximizedFocus 'Office 2010 on windows 7

    Set oMail = Nothing
    Set oFolder = Nothing
End Sub


Function GetLastVerb(olkMsg As Outlook.MailItem) As String
Dim intVerb As Integer
intVerb = GetProperty(olkMsg, "http://schemas.microsoft.com/mapi/proptag/0x10810003")
Select Case intVerb
    Case 102
        'Reply to Sender
        GetLastVerb = "Reply to Sender, " & GetLastVerbTime(olkMsg)
    Case 103
        'Reply to All
        GetLastVerb = "Reply to All, " & GetLastVerbTime(olkMsg)
    Case 104
        'Forward
        GetLastVerb = "Forward, " & olkMsg.ReceivedTime
    Case 108
        'Reply to Forward
        GetLastVerb = "Reply to Forward, " & GetLastVerbTime(olkMsg)
    Case Else
        'Unknown
        GetLastVerb = "Unknown, " & olkMsg.ReceivedTime
End Select
End Function


Public Function GetProperty(olkItm As Object, strPropName As String) As Date
Dim olkPA As Outlook.PropertyAccessor
Set olkPA = olkItm.PropertyAccessor
GetProperty = olkPA.GetProperty(strPropName)
Set olkPA = Nothing
End Function


Function GetLastVerbTime(olkItm As Object) As Variant
GetLastVerbTime = GetDateProperty(olkItm, "http://schemas.microsoft.com/mapi/proptag/0x10820040")
End Function


Public Function GetDateProperty(olkItm As Object, strPropName As String) As Date
Dim olkPA As Outlook.PropertyAccessor
Set olkPA = olkItm.PropertyAccessor
If Not IsNull(olkPA.GetProperty(strPropName)) Then
    GetDateProperty = olkPA.UTCToLocalTime(olkPA.GetProperty(strPropName))
End If
Set olkPA = Nothing
End Function