Counting categories based on date - vba

Question

The code below does not count categories from specific day properly:
Sub HowManyEmails()
Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder
Dim EmailCount As Integer
Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")
On Error Resume Next
Set objFolder = Session.GetFolderFromID(Application.ActiveExplorer.CurrentFolder.EntryID)
If Err.Number <> 0 Then
Err.Clear
MsgBox "No such folder."
Exit Sub
End If
EmailCount = objFolder.Items.Count
MsgBox "Number of emails in the folder: " & EmailCount, , "email count"
Dim dateStr As String
Dim myItems As Outlook.Items
Dim dict As Object
Dim msg As String
Dim oDate As String
Set dict = CreateObject("Scripting.Dictionary")
oDate = InputBox("Date for count (Format D-M-YYYY")
Set myItems = objFolder.Items.Restrict("[Received] >= '" & oDate & "'")
myItems.SetColumns ("Categories")
For Each myItem In myItems
dateStr = myItem.Categories
If Not dict.Exists(dateStr) Then
dict(dateStr) = 0
End If
dict(dateStr) = CLng(dict(dateStr)) + 1
Next myItem
msg = ""
For Each o In dict.Keys
msg = msg & o & ": " & dict(o) & vbCrLf
Next
MsgBox msg
Set objFolder = Nothing
Set objnSpace = Nothing
Set objOutlook = Nothing
End Sub
When you write a date, the output is just categories and emails count which doesn't match the chosen date.

Answer 1

The date format, valid for someone else, is likely not valid for you.
Option Explicit
Private Sub HowManyEmails()
Dim objFolder As Folder
Dim EmailCount As Integer
Dim myItem As Object
Dim o As Variant
Dim dateStr As String
Dim myItems As items
Dim dict As Object
Dim msg As String
Dim oDate As String
On Error Resume Next
Set objFolder = ActiveExplorer.CurrentFolder
If err.number <> 0 Then
err.Clear
MsgBox "No such folder."
Exit Sub
End If
' Must closely follow an On Error Resume Next
On Error GoTo 0
EmailCount = objFolder.items.count
MsgBox "Number of emails in the folder: " & EmailCount, , "email count"
Set dict = CreateObject("Scripting.Dictionary")
' oDate = InputBox("Date for count (Format D-M-YYYY")
oDate = InputBox("Date for count (Format YYYY-m-d")
Set myItems = objFolder.items.Restrict("[Received] >= '" & oDate & "'")
' myItems.SetColumns ("Categories") ' You will find this error due to On Error GoTo 0
For Each myItem In myItems
dateStr = myItem.Categories
If Not dict.exists(dateStr) Then
dict(dateStr) = 0
End If
dict(dateStr) = CLng(dict(dateStr)) + 1
Next myItem
msg = ""
For Each o In dict.Keys
If o = "" Then
msg = msg & dict(o) & ": " & "Not categorized" & vbCrLf
Else
msg = msg & dict(o) & ": " & o & vbCrLf
End If
Next
MsgBox msg
ExitRoutine:
Set objFolder = Nothing
Set dict = Nothing
End Sub