Measure response time between receipt of Outlook email and the reply by date: Error returning PR_RECEIVED_BY_ENTRYID from email

Question

I have a requirement to count the number of emails received in a shared mailbox folder and get a measure of the time taken to reply to an email.

Ideally to export the data into an Excel s/sheet with column headers:

• Three fields from the sender's email:

  1. From
  2. Subject
  3. Date / time (sent/received)

• Four fields from the reply:

  1. From [always the same set email address]
  2. To
  3. Subject
  4. Replied (date / time)

In the eighth column will be a calculation to evaluate the time between receipt of email and response to find quickest, slowest and average response times.

Option Explicit

Public ns As Outlook.Namespace

Private Const EXCHIVERB_REPLYTOSENDER = 102
Private Const EXCHIVERB_REPLYTOALL = 103
Private Const EXCHIVERB_FORWARD = 104

Private Const PR_LAST_VERB_EXECUTED = "http://schemas.microsoft.com/mapi/proptag/0x10810003"
Private Const PR_LAST_VERB_EXECUTION_TIME = "http://schemas.microsoft.com/mapi/proptag/0x10820040"
Private Const PR_SMTP_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
Private Const PR_RECEIVED_BY_ENTRYID As String = "http://schemas.microsoft.com/mapi/proptag/0x003F0102"

' Locates best matching reply in related conversation to the given mail message passed in as oMailItem
Private Function GetReply(oMailItem As MailItem) As MailItem
    Dim conItem As Outlook.Conversation
    Dim ConTable As Outlook.Table
    Dim ConArray() As Variant
    Dim MsgItem As MailItem
    Dim lp As Long
    Dim LastVerb As Long
    Dim VerbTime As Date
    Dim Clockdrift As Long
    Dim OriginatorID As String
    
    Set conItem = oMailItem.GetConversation ' Let Outlook and Exchange do the hard lifting to get entire converstion for email being checked.
    OriginatorID = oMailItem.PropertyAccessor.BinaryToString(oMailItem.PropertyAccessor.GetProperty(PR_RECEIVED_BY_ENTRYID))
    
    If Not conItem Is Nothing Then ' we have a conversation in which we should be able to match the reply
        Set ConTable = conItem.GetTable
        ConArray = ConTable.GetArray(ConTable.GetRowCount)
        LastVerb = oMailItem.PropertyAccessor.GetProperty(PR_LAST_VERB_EXECUTED)
        Select Case LastVerb
            Case EXCHIVERB_REPLYTOSENDER, EXCHIVERB_REPLYTOALL ', EXCHIVERB_FORWARD ' not interested in forwarded messages
                VerbTime = oMailItem.PropertyAccessor.GetProperty(PR_LAST_VERB_EXECUTION_TIME)
                VerbTime = oMailItem.PropertyAccessor.UTCToLocalTime(VerbTime) ' convert to local time
                ' Debug.Print "Reply to " & oMailItem.Subject & " sent on (local time): " & VerbTime
                For lp = 0 To UBound(ConArray)
                    If ConArray(lp, 4) = "IPM.Note" Then ' it is a mailitem
                        Set MsgItem = ns.GetItemFromID(ConArray(lp, 0)) 'mail item to check against
                        If Not MsgItem.Sender Is Nothing Then
                            If OriginatorID = MsgItem.Sender.ID Then
                                Clockdrift = DateDiff("s", VerbTime, MsgItem.SentOn)
                                If Clockdrift >= 0 And Clockdrift < 300 Then ' Allow for a clock drift of up to 300 seconds. This may be overgenerous
                                    Set GetReply = MsgItem
                                    Exit For ' only interested in first matching reply
                                End If
                            End If
                        End If
                    End If
                Next
            Case Else
        End Select
    End If
    ' as we exit function GetMsg is either Nothing or the reply we are interested in
End Function

Public Sub ListIt()
    Dim myOlApp As New Outlook.Application
    Dim myItem As Object ' item may not necessarily be a mailitem
    Dim myReplyItem As Outlook.MailItem
    Dim myFolder As Folder
    Dim xlRow As Long
      
    Set ns = myOlApp.GetNamespace("MAPI") ' Initialise Outlook access
    Set myFolder = ns.PickFolder() ' for the sake of this example we just pick a folder.
    
    InitSheet ActiveSheet ' initialise the spreadsheet
    
    xlRow = 3
    For Each myItem In myFolder.Items
        If myItem.Class = olMail Then
            Set myReplyItem = GetReply(myItem) ' this example only deals with mailitems
            If Not myReplyItem Is Nothing Then ' we found a reply
                PopulateSheet ActiveSheet, myItem, myReplyItem, xlRow
                xlRow = xlRow + 1
            End If
        End If
        DoEvents ' cheap and nasty way to allow other things to happen
    Next
  
    MsgBox "Done"
    
End Sub

Private Sub InitSheet(mySheet As Worksheet)
    With mySheet
        .Cells.Clear
        .Cells(1, 1).FormulaR1C1 = "Received"
        .Cells(2, 1).FormulaR1C1 = "From"
        .Cells(2, 2).FormulaR1C1 = "Subject"
        .Cells(2, 3).FormulaR1C1 = "Date/Time"
        .Cells(1, 4).FormulaR1C1 = "Replied"
        .Cells(2, 4).FormulaR1C1 = "From"
        .Cells(2, 5).FormulaR1C1 = "To"
        .Cells(2, 6).FormulaR1C1 = "Subject"
        .Cells(2, 7).FormulaR1C1 = "Date/Time"
        .Cells(2, 8).FormulaR1C1 = "Response Time"
    End With
End Sub

Private Sub PopulateSheet(mySheet As Worksheet, myItem As MailItem, myReplyItem As MailItem, xlRow As Long)
    Dim recips() As String
    Dim myRecipient As Outlook.Recipient
    Dim lp As Long
    
    With mySheet
        .Cells(xlRow, 1).FormulaR1C1 = myItem.SenderEmailAddress
        .Cells(xlRow, 2).FormulaR1C1 = myItem.Subject
        .Cells(xlRow, 3).FormulaR1C1 = myItem.ReceivedTime
        '.Cells(xlRow, 4).FormulaR1C1 = myReplyItem.SenderEmailAddress
        .Cells(xlRow, 4).FormulaR1C1 = myReplyItem.Sender.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS) ' I prefer to see the SMTP address
        For lp = 0 To myReplyItem.Recipients.Count - 1
            ReDim Preserve recips(lp) As String
            recips(lp) = myReplyItem.Recipients(lp + 1).Address
        Next
        .Cells(xlRow, 5).FormulaR1C1 = Join(recips, vbCrLf)
        .Cells(xlRow, 6).FormulaR1C1 = myReplyItem.Subject
        .Cells(xlRow, 7).FormulaR1C1 = myReplyItem.SentOn
        .Cells(xlRow, 8).FormulaR1C1 = "=RC[-1]-RC[-5]"
        .Cells(xlRow, 8).NumberFormat = "[h]:mm:ss"
    End With
End Sub

I get:

The property "http://schemas.microsoft.com/mapi/proptag/0x003F0102" is unknown and cannot be found.

Answer 1

First of all, I've noticed the following lines of code:

For Each myItem In myFolder.Items
        If myItem.Class = olMail Then

Iterating over all items in the folder is not really a good idea. Instead, you'd need to process items in chucks to release the Outlook UI. All the logic is run on the main thread (UI thread) so Outlook will be frozen if the folder contains a lot of items in the folder. The Find/FindNext or Restrict methods of the Items class help to find items that correspond to your conditions. Read more about these methods in the following articles:

• How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
• How To: Use Restrict method to retrieve Outlook mail items from a folder

Finally, the MailItem.ReceivedByEntryID property returns a string representing the EntryID for the true recipient as set by the transport provider delivering the mail message. So, the property is set on received items only. You need to filter newly-created items for editing and sending and received ones. The property doesn't exist on the composed items.

Answer 2

No MAPI property is guaranteed to be present. The error is expected and must be handled (on error resume next / err.Clear / if err.Number <> 0 Then)