Option
Explicit
Sub
Test()
Dim
folder1
As
Outlook.Folder
Dim
folder2
As
Outlook.Folder
Set
folder1 = ...
Set
folder2 = ...
Dim
strFilter
As
String
strFilter = CreateDateTimeFilter(DateSerial(2022, 12, 1), DateSerial(2022, 12, 31))
Dim
objItems
As
Outlook.Items
Set
objItems = folder1.Items.Restrict(strFilter)
Dim
colAllMailItems
As
VBA.Collection
Call
AddMailItemsFromItems(objItems, colAllMailItems)
Dim
objMailItem
As
Outlook.MailItem
For
Each
objMailItem
In
colAllMailItems
Debug.Print objMailItem.Parent.Name, objMailItem.Subject
Next
End
Sub
Public
Function
CreateDateTimeFilter(DateFrom
As
Date
, DateTo
As
Date
)
Const
OL_RESTRICT_DATETIME_FORMAT =
"ddddd h:nn AMPM"
CreateDateTimeFilter = _
"[SentOn] >= '"
& Format$(DateFrom, OL_RESTRICT_DATETIME_FORMAT) &
"' "
& _
"AND [SentOn] <= '"
& Format$(DateTo, OL_RESTRICT_DATETIME_FORMAT) &
"'"
End
Function
Public
Sub
AddMailItemsFromItems(
ByVal
Items
As
Outlook.Items,
ByRef
MailItemCollection
As
VBA.Collection)
If
MailItemCollection
Is
Nothing
Then
Set
MailItemCollection =
New
VBA.Collection
End
If
Dim
objItem
As
Object
For
Each
objItem
In
Items
If
TypeOf
objItem
Is
Outlook.MailItem
Then
Call
MailItemCollection.Add(objItem)
End
If
Next
End
Sub