Measure response time between receipt of Outlook email and the reply by date Overflow 1

[kwo]

Following up on the following thread: thread707-1739523

I have been using this VBA to track the response time from my team's email. It has been working for the past couple weeks from my team's email, but for some reason, today, I have come across an Overflow message on row 162.

Thinking there is a limit to the data able to be received, I tried on my own email and was able to reach up to the 400s. Does anyone have an idea to what may be causing this issue?

I'm not at all skilled in VBA, so if anyone has any solutions to this issue, I would very much appreciate it. If it really is based on the number of data rows received, I would be so grateful if someone can manage to edit the code to only receive data from within the past week. Thank you!


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

 

[strongm]

You need to tell us which line of code is causing the error, not which Excel row it is happening on

 

[kwo]

Thank you so much for responding! The following line of code caused an error for me.

If Clockdrift >= 0 And Clockdrift < 300 Then ' Allow for a clock drift of up to 300 seconds. This may be overgenerous

 

[strongm]

>an error for me

The Overflow error you mention in the original post, or a different error If the former, then I'm afraid I can't figure out how you would get to an Overflow error at that line. If the latter, exactly what error message are you seeing?

 

[kwo]

Hi strongm,

I got the following error: "Run-tem error '6': Overflow"

And my mistake, I got the error on Clockdrift = DateDiff("s", VerbTime, MsgItem.SentOn)

Thank you!

 

[Andrzejek]

Run-tem error '6': Overflow"

That usually happen when you try to cram too much into a variable, like you try to use an Integer above 32,767


---- Andy

There is a great need for a sarcasm font.

 

[strongm]

OK, so NOT opn the line you previously suggested. And that's a good thing in one sense - as I said, I couldn't see how you'd get an overflow with that line.

With the new line, it's easy. As Andy alludes, we are trying to stick a result into ClockDrift that is too large for its datatype (a long). That's the good news - we know why it is happening*. The bad news is that for that to be the case the time difference has to be more than 2,147,483,647 seconds, which is about 68 years. Given that it is extremely unlikely that it took over 68 years to save the response to the message store (which is what ClockDrift is tring to estimate), this implies that one of the datetimes in use (VerbTime or SentOn) is corrupt, or holds a special value with a meaning I am unaware of for thois particular mailitem.

It'd be worth you examining both these values in debug mode when the error recurs

* Illustration of the error:

[blue]    Dim ss As Long
    
    ss = DateDiff("s", "4 jun 1952", "22 jun 2020")
    MsgBox ss
    ss = DateDiff("s", "3 jun 1952", "22 jun 2020") [COLOR=green]' overflow expected[/color]
    MsgBox ss[/blue]

 

[kwo]

Thank you Andy and strongm!

How would you suggest I examine the values in debug mode? When stepping into the debug issue, all I see is the line that's causing the issue.

Thank you!

 

[Andrzejek]

If this is the ‘issue’ line:

Clockdrift = DateDiff("s", VerbTime, MsgItem.SentOn)

You may do when the error happen - in the Immediate Window type:[tt]
? “VerbTime is ” & VerbTime & “ and MsgItem.SentOn is “ & MsgItem.SentOn[/tt]

---- Andy

There is a great need for a sarcasm font.

 

[strongm]

>all I see is the line that's causing the issue.

Ok, to ake sure we are o the same page

1) In the IDE: Tools > Options > General > Error Trapping -> Break on all errors
2) Run program
3) On hotting the error, you should get a dialog:

4) Click the debug botton. You should end up with the erroring line highlighted

You now have several optionsd.

1) Simply hover the pointer over either of the variables and you should see an infotip with the current value
2) Right-click each variable and select 'Add watch ...", and you will now be able to see the values in the Watch window (if the Watch window is not visible, toggle it on under the View menu)
3) Select Locals Window from the View menu, and you should eb able to see all variables currently in scope, which should include the ones we are interested in
4) Andy's Immediate window method ...

 

[kwo]

Thank you, Strongm and Andy!

This is such a strange problem to me. I didn't get a chance to make any changes to the VBA yet or get a chance to debug the ClockDrift issue, but when I tried rerunning the VBA to follow strongm's steps, I came across a different issue.

I now have another error issue saying "run-time error '-2147467259 (80004005)': A timeout occured when obtaining conversation results" on this line: ConArray = ConTable.GetArray(ConTable.GetRowCount)

I didn't do anything to the code or to outlook other than to respond to some emails like normal. This issue is also affecting my own email results, not just my team's. Have either of you ever come across this issue before?

 

[strongm]

Sounds to me like you've got flakey connectivity to your Exchange server

 

[kwo]

You were right, strongm! After shutting off my computer, that issue went away.

I followed strongm's steps, and it looks like the SentOn time is corrupt. When hovering my cursor over the VerbTime, I got 06/16/2020 10:06:00 AM. But when I do the same for SentOn, I got 01/01/4501, which I'm sure we all know is wrong.

When I followed strongm's Watch Window steps, I got the attached results. I'm going to be honest though and admit I don't really understand Andy's Immediate Window steps.

Thank you!

 

[Andrzejek]

>Immediate Window steps.

Take a look at the 5 Ways to Use the VBA Immediate Window in Excel


---- Andy

There is a great need for a sarcasm font.

 

[strongm]

>01/01/4501

Aha!! That is a special response returned by the Outlook Object Model when the underlying MAPI property does not exist (e.g this is a reply that hasn't actually been sent yet ...)

So you can just add a check for this SentOn date, and skip the mesgitem if that special date is found

E.g Change this line

[blue]If Not MsgItem.Sender Is Nothing Then[/blue]

into

[blue]If Not MsgItem.Sender Is Nothing And MsgItem.SentOn <> CDate("1 Jan 4501") Then[/blue]

 

[kwo]

Andy-thanks for the reference! Now I better understand how to debug an issue in VBA

Strongm-it works now!!! Thank you so much for your help! By the way, while I have you here, can you explain whether the code is only supposed to go back to a certain date? For some reason, every time I've been refreshing the data, it's been starting at 3/9/2020 when my team's email has email going back to 2019. Not an issue or anything, but I am curious. And maybe 6 months down the line, would the data still be refreshing all the way back to 3/9/2020? Or is there a limit to the data?

 

[strongm]

>my team's email has email going back to 2019

Is your Exchange Server doing any sort of archiving (e.g something like Veritas Enterprise Vault), set to archive anything older than 16 weeks?

 

[kwo]

Yes, but we're archiving anything older than 13 months. We cannot see any emails older than July 2019, so it seems strange to me that your VBA is only pulling in data all the way back to 03/09/2020.

 

[strongm]

>your VBA is only pulling in data

My VBA does not define any date limits whatsoever. It populates a array directly from a full conversation returned by Outlook:

Set conItem = oMailItem.GetConversation

and subsequently simply steps through the returned conversation and that's it. As you can see, there are NO date parameters involved. This is more likely to be related to something set up in Outlook or Exchange Server, which is why I asked about archiving. Or perhaps a filter.

 

[kwo]

Interesting. I don't have any filters in place, and my team definitely has emails that hasn't been archived for a year. Maybe there's another setting in place for my team's email that I don't know of.