У меня есть макрос для подсчета количества писем в Outlook по категориям.
Наряду с этим мне нужна самая старая дата почты в определенной категории.Например, в категории «Красное» есть 20 писем, так какая дата самой старой почты в категории «Красное»?
Sub CategoriesEmails()
Dim oFolder As MAPIFolder
Dim oDict As Object
Dim sStartDate As String
Dim sEndDate As String
Dim oItems As Outlook.Items
Dim sStr As String
Dim sMsg As String
Dim strFldr As String
Dim OutMail As Object
Dim xlApp As Object
On Error Resume Next
Set oFolder = Application.ActiveExplorer.CurrentFolder
Set oDict = CreateObject("Scripting.Dictionary")
sStartDate = Date - 365
sEndDate = Date
Set oItems = oFolder.Items.Restrict("[Received] >= '" & sStartDate & "' And [Received] <= '" & sEndDate & "'")
oItems.SetColumns ("Categories")
For Each aItem In oItems
sStr = aItem.Categories
If Not oDict.Exists(sStr) Then
oDict(sStr) = 0
End If
oDict(sStr) = CLng(oDict(sStr)) + 1
Next aItem
sMsg = ""
i = 0
strFldr = "C:\Users\singhab\Desktop\Macro\"
Set xlApp = CreateObject("Excel.Application")
xlApp.Application.Visible = True
xlApp.Workbooks.Open strFldr & "Test.xlsx"
xlApp.Sheets("Sheet1").Select
For Each aKey In oDict.Keys
xlApp.Range("a1").Offset(i, 0).Value = sMsg & aKey
xlApp.Range("B1").Offset(i, 0).Value = oDict(aKey) & vbCrLf
i = i + 1
Next
xlApp.Save
Set oFolder = Nothing
End Sub
Я получаю вывод
![Result after running the above macro](https://i.stack.imgur.com/AM9NJ.png)
То, что я хочу, это
![oldest mail date for each particular category](https://i.stack.imgur.com/MjU0j.png)