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