How to count emails within an hourly range?

Question

My team uses outlook to track completed work. All work needs to be completed within 48 hours of receipt and we need to keep strict track of it. I've managed to put together a function that counts the emails that have fallen outside of the 2 day range, but the track needs to be kept down to an hour.

No matter how many configurations I try I was unable to get my code to count within hourly range. This is what my current code looks like:

Dim OOSLAitms As Outlook.Items
Dim DateDiff As Long
Dim Filter As String
Dim i As Long
DateDiff = Now - 2
    Filter = "[Received]  < '" & Day(DateDiff) & _
                         "/" & Month(DateDiff) & _
                         "/" & Year(DateDiff) & "'"

Set OOSLAitms = itms.Restrict("[FlagStatus] = 0")
Set OOSLAitms = OOSLAitms.Restrict(Filter)

For i = OOSLAitms.Count To 1 Step -1
    Worksheets("Sheet1").Range("F4").Value = OOSLAitms.Count
Next

This manages to count all the emails received within the calendar day, but does not take hours of the day into account. So for example if we received 300 cases on Sunday, it will count all of them up to midnight, instead of only counting ones up to current time (4pm for example).

I need help incorporating hour/minutes criteria into my code on top of day/month/year if it's possible.

Answer 1

Okay after playing around with it some more (and a generous amount of debug messageboxes) I've managed to get it to work using the following trick:

1. Created an output cell 'A11' on the first sheet running a =NOW() function formatted to "ddd dd/mm/yyyy hh:mm"

2. Created a cell 'A1' on the processing sheet that was running 'Sheet1!A11 - 2' formula. The reason why is that for some reason when doing 'Now - 2' through VBA, even with formatting it was always giving midnight. Doing it through autocalc in cells gives correct deduction down to a second.

The reason for formatting "dd dd/mm/yyyy hh:mm" is that this is the format that the "Received" column in outlook stores the receive times. Not providing that 'ddd' in front of the datetime string results in an automation error.

Final code looks like this:

Dim OOSLAitms As Outlook.Items
Dim DateDiff As Long
Dim Filter As String
Dim Today As String

Today = Format(ThisWorkbook.Sheets("Sheet2").Range("A1"), "ddd dd/mm/yyyy hh:mm")
        Filter = "[Received]" & "<" & Today

Set OOSLAitms = itms.Restrict("[FlagStatus] = 0")
Set OOSLAitms = OOSLAitms.Restrict(Filter)
Worksheets("Sheet1").Range("F4").Value = OOSLAitms.Count

Answer 2

There is no Received property, you must use the ReceivedTime instead.

And if you need to get hourly range only, you must specify boundaries for the search criteria:

Dim searchCriteria As String = "[ReceivedTime]<=""" + dateTimeEnd + """ AND [ReceivedTime]>=""" + dateTimeStart + """"