获取每个类别中最早的邮件的日期

时间:2018-12-05 11:56:04

标签: excel vba outlook outlook-vba outlook-filter

我有一个宏来获取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

我想要的是
oldest mail date for each particular category

1 个答案:

答案 0 :(得分:0)

Items.GetFirst Method (Outlook)一起使用,该方法返回一个Object值,该值代表集合中包含的第一个对象

代码示例

Option Explicit
Public Sub Example()
    Dim olNs As Outlook.NameSpace
    Set olNs = Application.GetNamespace("MAPI")

    Dim Inbox  As Outlook.MAPIFolder
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)

    Dim Items As Outlook.Items
    Set Items = Inbox.Items.Restrict("[Categories] = 'Red Category'")

    Dim Item As Object
    Set Item = Items.GetFirst

    Debug.Print Item.Subject & " " & Item.ReceivedTime
End Sub