Using VBA in Outlook to gather statistics on received emails

Question

At work we use a shared Outlook mailbox to receive emails from our users, and at the moment we have a rota of who's turn it is to monitor the mailbox and reply etc. Our working hours have been 7am-5pm since we started the email address.

For the next 2 months we're trailing a change in hours where we (or should I say, myself only) will be monitoring the mailbox up until 11pm.

What I'd like to do is gather some statistics on the emails we receive to see if it is worth it from a business view to keep the later shift on after the trail.

What I was thinking of doing is using some VBA to check the emails in the inbox, and then break the data down into some stats for management, eg:

Monday 06/05/12: 
49 emails received, 34 were replies, 15 were new
At 7am received: 0 emails
At 8am received: 1 emails
------
At 11pm received: 0 emails

etc

To work out if an email is an original or reply I think it's easiest to see if the subject starts with RE:? (I know it's not foolproof but I think it'll work for basic stats)

Has anyone done anything like this before? Is there an easy/right way of doing it?

Anyone got any tips/code samples that would be useful?

Answer 1

You could start with something like this

Sub EmailStats()

    Dim olMail As MailItem
    Dim aOutput() As Variant
    Dim lCnt As Long
    Dim xlApp As Excel.Application
    Dim xlSh As Excel.Worksheet
    Dim flInbox As Folder

    Set flInbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

    ReDim aOutput(1 To flInbox.Items.Count, 1 To 4)

    For Each olMail In flInbox.Items
        If TypeName(olMail) = "MailItem" Then
            lCnt = lCnt + 1
            aOutput(lCnt, 1) = olMail.SenderEmailAddress 'maybe stats on domain
            aOutput(lCnt, 2) = olMail.ReceivedTime 'stats on when received
            aOutput(lCnt, 3) = olMail.ConversationTopic 'group based on subject w/o regard to prefix
            aOutput(lCnt, 4) = olMail.Subject 'to split out prefix
        End If
    Next olMail

    Set xlApp = New Excel.Application
    Set xlSh = xlApp.Workbooks.Add.Sheets(1)

    xlSh.Range("A1").Resize(UBound(aOutput, 1), UBound(aOutput, 2)).Value = aOutput
    xlApp.Visible = True

End Sub

If you want to add more data, just change the Redim statement to accommodate more columns and add them in the If block. Once in Excel (or maybe Access or SQLServer if it's a lot of data), you can add a few calculations, like

=IF(LEFT(@Subject,3)="RE:","Reply",IF(LEFT(@Subject,3)="FW:","Forward","Original"))

Then pivot like crazy.

You need a reference to the Excel object library for the above code to work.