Using VBA to calculate the amount of emails received in an outlook folder, preferably being able to choose a start and end date for the count

[crocie]

Hi all,
I am new to this forum, looking to expand my VBA knowledge.
I have seen various codes in order to count the amount of emails in an outlook folder, such as ;

Code:
Sub count()
Dim objItems As Outlook.Items
Dim objItem As Object
Dim objMail As Outlook.MailItem
Dim strMonth As String
Dim dReceivedTime As Date
Dim strReceivedDate As String
Dim i, n As Long
Dim strMsg As String
Dim nPrompt As Integer

Set objItems = Outlook.Application.ActiveExplorer.CurrentFolder.Items

objItems.SetColumns ("ReceivedTime")
strMonth = InputBox("Enter the specific month.(Format: yyyy-mm-dd)", "Specify month")

If strMonth <> "" Then
n = 0
For i = 1 To objItems.Count
If objItems.Item(i).Class = olMail Then
Set objMail = objItems.Item(i)
dReceivedTime = objMail.ReceivedTime
strReceivedDate = Year(dReceivedTime) & " - " & Month(dReceivedTime)
If strReceivedDate = strMonth Then
n = n + 1
End If
End If
Next i

strMsg = "You have received " & n & " emails on " & strMonth & "."
nPrompt = MsgBox(strMsg, vbExclamation, "Count Received Emails")
Else
nPrompt = MsgBox("Please input the specific day!", vbExclamation)
End If
End Sub
This code I found is from 2019 - so I was wondering if there is any update to this to make it quicker? I also specifically would like to have a way (if possible) to count the amount of emails received in the outlook folder between a specific start and end date, as well as having the rolling count, and count since VBA was last run.
Any advice greatly appreciated

Best

 

[crocie]

I have tried the code -

Sub count()
Dim objItems As Outlook.Items
Dim objItem As Object
Dim objMail As Outlook.MailItem
Dim strMonth As String
Dim dReceivedTime As Date
Dim strReceivedDate As String
Dim i, n As Long
Dim strMsg As String
Dim nPrompt As Integer

Dim NS As NameSpace
Dim folder As MAPIFolder
Dim subfolder As MAPIFolder
Dim latestDate As Date

Set NS = Application.GetNamespace("MAPI")

Set folder = NS.GetDefaultFolder(olFolderInbox).Folders("Subfolder1")

strMonth = InputBox("Enter the specific month.(Format: yyyy)", "Specify year")

If strMonth <> "" Then
n = 0
For Each subfolder In folder.Folders
Set objItems = subfolder.Items

'Set objItems = Outlook.Application.Posteingang

' objItems.SetColumns ("ReceivedTime")
For i = 1 To objItems.count
If objItems.Item(i).Class = olMail Then
Set objMail = objItems.Item(i)
dReceivedTime = objMail.ReceivedTime
strReceivedDate = Format(dReceivedTime, "yyyy")
If strReceivedDate = strMonth Then
If dReceivedTime > latestDate Then
latestDate = dReceivedTime
End If
n = n + 1
End If
End If
Next i
Next subfolder

strMsg = "You have received " & n & " emails on " & strMonth & "."
strMsg = strMsg & vbCrLf & vbCrLf
strMsg = strMsg & "The latest email was received on " & Format(latestDate, "mm/dd/yyyy") & "."
nPrompt = MsgBox(strMsg, vbExclamation, "Count Received Emails")
Else
nPrompt = MsgBox("Please input the specific day!", vbExclamation)
End If
End Sub
But when running - I get the error > Run time error -'2147221233 (8004010f)
the attempted operation failed. An object could not be found.