How to sum hours, minutes, or seconds in Outlook

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
I'm working on a macro using these sample dates - man, i hate working with times. :)

Dates 8/31/2017 9:22:34 PM 10/13/2017 4:51:00 PM
Days between 31

Using as received time of day - since it came in after hours, using next morning, subtract a day from the days between. (using bits of the code from the link you posted earlier to get the time values).
9:00:00 AM

Using as reply time of day
4:51:00 PM

Final calculation
Time to reply: 29 days 7.99375 hours

Now to test it on more messages. I'm not sold on my time calculations being correct, i think i got lucky.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Just discovered that the last verb time is in UTC (if its in a custom field in outlook, it is adjusted for the current time zone) - that screws the calculations up. :( I could use the same method to get the sent time, but that can mess up the calculations too.

Have I mentioned how much i hate working with times? :)
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
attached is a macro to test. I think the math leaves a bit to be desired - the problem is with after hours replies - it may not be a problem if you never reply after hours. I do, so i 'm using just the exact time calculations: repTime = TimeValue(Item.ReceivedTime) and marked out the if statements that calculate messages received outside of working hours as if they were received during working hours. That calculation is really where the problems are.


Dates 10/13/2017 8:41:19 AM 10/13/2017 8:49:00 AM
Days between 1
Using as received time of day 8:41:19 AM 0
Using as reply time of day 8:49:00 AM 0
Time to reply: 0 days 00:07

paste into outlook vba editor, select a message you replied to and run GetTimeForReply - look in the Immediate window to see if the values are correct.
 

Attachments

Outlook version
Outlook 2010 64 bit
Email Account
IMAP
Hi Diane, Thank you so much for replying. I did checked in vba editor and it was indeed correct result i got. Now i want this to be populated in new field as and when email is received. Is there any way we can call this macro as and when replied and result be stamped in new field?. I am also trying my best here.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
This is my latest version of the before reply time macro - it adds the field to the item. IMHO, i think it is better to use the total hours rather than days & remainder hours.

My math is still wrong though, at least for less than 8 hours:
Dates 10/18/2017 11:27:07 AM 10/19/2017 10:03:00 AM
Days between 1
Using as received time of day 11:27:07 AM 8 <== hours in a day
total hours 09:24 <<== should be 7ish hours.

it's correct if over 8 hours:
Dates 10/17/2017 11:03:37 PM 10/19/2017 10:09:00 AM
Days between 2
Using as received time of day 9:00:00 AM <<== the next morning since it came in after hours
total hours 09:09


Code:
Sub TimeBeforeReply()
Dim Item As MailItem
Dim propertyAccessor As Outlook.propertyAccessor
Dim rDate As Date
Dim tDays As Long

Dim recTime 'As Long
Dim repTime 'As Long
Dim strProp As String
Dim objProp As Outlook.UserProperty

Set Item = Application.ActiveExplorer.Selection.Item(1)
Set propertyAccessor = Item.propertyAccessor

' Get the date of the last reply or forward
rDate = propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x10820040")
' it's in UTC time, so we need to convert to local time
rDate = GetLocalTimeFromGMT(rDate)

Debug.Print "Dates", Item.ReceivedTime, rDate
Debug.Print "Days between", NetWorkdays2(Item.ReceivedTime, rDate, 65)

tDays = NetWorkdays2(Item.ReceivedTime, rDate, 65)

' Get the partial day - received
' Message arrives during business hours
If TimeValue(Item.ReceivedTime) > TimeValue(startDay) And TimeValue(Item.ReceivedTime) < TimeValue(endDay) Then
    recTime = TimeValue(Item.ReceivedTime)

' message arrives before business day begins, start counting at 9AM
ElseIf TimeValue(Item.ReceivedTime) < TimeValue(startDay) Then
    recTime = TimeValue(startDay)

' message arrives after business day ends, move to tomorrow at 9AM
ElseIf TimeValue(Item.ReceivedTime) > TimeValue(endDay) Then
    recTime = TimeValue(startDay)
    tDays = tDays - 1
End If
Dim tHours

tHours = tDays * hrsPerDay
Debug.Print "Using as received time of day", recTime, tHours

' replies are always during business hours
' so I'm not going to calculate this based on working hours
repTime = TimeValue(rDate)
sTime = Format(repTime - recTime, "hh:mm")

Dim dt As Date
dt = CDate(sTime)
dt = DateAdd("h", tHours, dt)

strProp = Format(dt, "hh:nn")
Debug.Print "total hours", strProp
Set objProp = Item.UserProperties.Add("Time Reply", olText, True)
objProp.Value = strProp
Item.Save


End Sub
 
Outlook version
Outlook 2010 64 bit
Email Account
IMAP
Happy Diwali...Diane..

Wow Wow Wow....i dont have words to express my happiness. Your responses to my help is outstanding. Let me try and come back to you.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
oh, BTW, this snippet is what i have so far to get the correct time. it's messy and needs cleaned up, but gets the correct time if under 8 hours. We can drop the if and use the atime, btime calcs to get all times, as long as we properly subtract the # of days (which was one of my early comments to subtract 2 from the # of days)

Code:
tHours = tDays * hrsPerDay

Debug.Print "Using as received time of day", receivedTime, tHours

' replies are always during business hours
' so I'm not going to calculate this based on working hours
replyTime = TimeValue(rDate)

If tHours <= 8 Then
atime = TimeValue(endDay) - receivedTime
btime = replyTime - TimeValue(startDay)
Debug.Print Format(atime, "hh:nn"), Format(btime, "hh:nn")
dt = atime + btime
Debug.Print Format(dt, "hh:nn")

Else
sTime = Format(replyTime - receivedTime, "hh:nn")
dt = CDate(sTime)
dt = DateAdd("h", tHours, dt)
End If

strProp = Format(dt, "hh:nn")
Debug.Print "total hours", strProp
Set objProp = Item.UserProperties.Add("Time Reply", olText, True)
objProp.Value = strProp
Item.Save
 
Outlook version
Outlook 2010 64 bit
Email Account
IMAP
Hi Diane,

I was able to clean up the code and got that working..Thank you so much for your help. It was indeed 10 months effort. Now i want this macro to take into new height and i want your help again. As i said earlier, I am tracking / want to track shared email account where team sits in three different locations. Your configuration file helped me in
1) Reply / Reply all / Forward
2) At what time Reply / Reply all / Forward done
3) who has responded to the email (I have added one more property in your configuration file but that is showing)

Remember these fields are visible to me only because i have installed into my outlook and

Now with this macro, it tells me whether or not how much time it took to respond ignoring weekends. My question -
Can we create some sort of cfg file / add-in file so that it stamps the above macro results as and when the email is actioned? These cfg / add-in will be easy to install by my IT team from a backend. - Your inputs required.

Below is the modified macro.
Code:
Sub TimeBeforeReply()
Dim Item As MailItem
Dim propertyAccessor As Outlook.propertyAccessor
Dim rDate As Date
Dim tDays As Long
Dim recTime 'As Long
Dim repTime 'As Long
Dim strProp As String
Dim objProp As Outlook.UserProperty
Dim objProp1 As Outlook.UserProperty
Dim dt As String

Set Item = Application.ActiveExplorer.Selection.Item(1)
Set propertyAccessor = Item.propertyAccessor

' Get the date of the last reply or forward
rDate = propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x10820040")
' it's in UTC time, so we need to convert to local time
rDate = GetLocalTimeFromGMT(rDate)

Debug.Print "Dates", Item.ReceivedTime, rDate
Debug.Print "Workdays", NetWorkdays2(Item.ReceivedTime, rDate, 65)

tDays = NetWorkdays2(Item.ReceivedTime, rDate, 65)

' Get the partial day - received
' Message arrives during business hours
If TimeValue(Item.ReceivedTime) > TimeValue(startDay) And TimeValue(Item.ReceivedTime) < TimeValue(endDay) Then
    recTime = TimeValue(Item.ReceivedTime)
  
' message arrives before business day begins, start counting at 9AM
ElseIf TimeValue(Item.ReceivedTime) < TimeValue(startDay) Then
    recTime = TimeValue(startDay)
  
' message arrives after business day ends, move to tomorrow at 9AM
ElseIf TimeValue(Item.ReceivedTime) > TimeValue(endDay) Then
    recTime = TimeValue(startDay)
  
End If

' Get the partial day - replied
' Message replied during business hours
If TimeValue(rDate) > TimeValue(startDay) And TimeValue(rDate) < TimeValue(endDay) Then
    repTime = TimeValue(rDate)
  
' message replied before business day begins, start counting at 9AM
ElseIf TimeValue(rDate) < TimeValue(startDay) Then
    repTime = TimeValue(startDay)
    tDays = tDays - 1

' message replied after business day ends, move to tomorrow at 9AM
ElseIf TimeValue(rDate) > TimeValue(endDay) Then
    repTime = TimeValue(endDay)
    tDays = tDays - 1
End If

Dim tHours
tHours = (tDays - 1) * hrsPerDay

'repTime = TimeValue(rDate)
If tHours <= 9 Then
stime = Format(repTime - recTime, "hh:nn")
dt = CDate(stime)
strProp = Format(dt, "hh:nn")
Debug.Print strProp

Else

atime = tHours
btime = TimeValue(repTime) - TimeValue(recTime)
Debug.Print Format(atime * 100, "00:00"), Format(btime, "hh:nn")
Debug.Print atime + Left(Format(btime, "hh:mm"), 2) & ":" & Right(Format(btime, "hh:mm"), 2)
dt = atime + Left(Format(btime, "hh:mm"), 2) & ":" & Right(Format(btime, "hh:mm"), 2)
strProp = Format(dt, "00:00")

End If

Debug.Print "total hours", strProp
Set objProp = Item.UserProperties.Add("Time Reply", olText, True)
Set objProp1 = Item.UserProperties.Add("Days worked", olText, True)
objProp.Value = strProp
objProp1.Value = tDays - 1 & " Day(s)"
Item.Save
End Sub
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
A CFG can add fields to the view but it's ability to do calculations is limited to the available functions. Addins are doable (and the best way to push it out to others in the company) but I don't do addins, in part because its more time consuming to support if the person doesn't have VS experience. The guys in the MSDN forums are available for that.
 
Outlook version
Outlook 2010 64 bit
Email Account
IMAP
Oh ok..not a problem I will do it on my own :). thanks for helping hand..will keep you posted about the progress
 

Top