Outlook 共享收件箱中超过 2 天的电子邮件总数/已读/未读/未读

Question

我正在尝试计算当天存储在共享邮箱中的 Outlook 邮件项目，并将这些值存储为 4 个类别： “Total”、“Read”、“Unread”、“Breached”（自到达收件箱以来已超过 2 天未读）。 除了“Breached”之外，每个类别都运行良好，因为它根本不计算它们。 我遇到的问题是，用双重条件做出正确的 if 语句，检查电子邮件是否未读以及是否超过 2 天。

我尝试使用其他循环遍历项目，但没有帮助。我也尝试过使用 RecievedTime 函数，但它也不起作用。问题出现在以下代码片段中：

For Each olMail In Fldr.Items.Restrict("@SQL=%today(""urn:schemas:httpmail:datereceived"")%")
        j = j + 1
        If olMail.UnRead = True Then
            i = i + 1
        If DateDiff("d", olMail.CreationTime, Now) >= 2 And olMail.UnRead = True Then
            h = h + 1
        End If
        End If

这是其余的代码，为了隐私起见，我更改了收件箱的名称和

Sub CountSelectedItems()
    Dim olApp As Application
    Dim SelItems As Outlook.Selection
    Dim IntRes As Integer
    Dim StrMsg As String
    Dim olMail As Variant
    Dim Fldr As Folder
    Dim processed As Integer

    Set olApp = Outlook.Application
    Set SelItems = olApp.ActiveExplorer.Selection
    Set Fldr = GetFolderPath("exemplaryName\Inbox")

    i = 0
    j = 0
    h = 0
    For Each olMail In Fldr.Items.Restrict("@SQL=%today(""urn:schemas:httpmail:datereceived"")%")
        j = j + 1
        If olMail.UnRead = True Then
            i = i + 1
        If DateDiff("d", olMail.CreationTime, Now) >= 2 And olMail.UnRead = True Then
            h = h + 1
        End If
        End If
    Next olMail


    processed = j - i
    StrMsg = "Total: " & j & vbNewLine & "Processed: " & processed & vbNewLine & "Not processed: " & i & vbNewLine & "Breached: " & h
    IntRes = MsgBox(StrMsg, vbOKOnly + vbInformation, "Count Selected Outlook Items")
    Call CreateNewMail(j, processed, i, h)
End Sub
' Use the GetFolderPath function to find a folder in non-default mailboxes
Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
    Dim oFolder As Outlook.Folder
    Dim FoldersArray As Variant
    Dim i As Integer

    On Error GoTo GetFolderPath_Error
    If Left(FolderPath, 2) = "\\" Then
        FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    'Convert folderpath to array
    FoldersArray = Split(FolderPath, "\")
    Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
    If Not oFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)
            Dim SubFolders As Outlook.Folders
            Set SubFolders = oFolder.Folders
            Set oFolder = SubFolders.Item(FoldersArray(i))
            If oFolder Is Nothing Then
                Set GetFolderPath = Nothing
            End If
        Next
    End If
    'Return the oFolder
    Set GetFolderPath = oFolder
    Exit Function

GetFolderPath_Error:
    Set GetFolderPath = Nothing
    Exit Function
End Function

Sub CreateNewMail(total, processed, unprocessed, breached)
    Dim obApp As Object
    Dim NewMail As MailItem
    Dim MyDate

    MyDate = Date

    Set obApp = Outlook.Application
    Set NewMail = obApp.CreateItem(olMailItem)

    With NewMail
         .Subject = "Processed/Unprocessed mailbox " & Date
         .To = "exemplaryEmail@example.com"
         .Body = "Hi" & vbCrLf & vbCrLf & "As of " & MyDate & " the current KM Mailbox messages status is: " & vbCrLf & "Total: " & total & vbCrLf & "Processed: " & processed & vbCrLf & "Unprocessed: " & unprocessed & vbCrLf & "Breached: " & breached & vbCrLf & vbCrLf & "Kind regards"
         .Display
    End With

    Set obApp = Nothing
    Set NewMail = Nothing
End Sub

Answer 1

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
'
' If desperate declare as variant


Sub CountItemsInFolder()

    Dim strMsg As String

    Dim allItems As items
    Dim unreadItems As items

    Dim agedItems As items
    Dim agedUnreadItems As items

    Dim fldr As folder

    Dim processed As Long

    Dim allItemsCount As Long
    Dim unreadItemsCount As Long

    Dim agedItemsCount As Long
    Dim agedUnreadItemsCount As Long

    Dim strFilterUnread As String
    Dim strFilterAged As String

    'Set Fldr = GetFolderPath("exemplaryName\Inbox")
    Set fldr = Session.GetDefaultFolder(olFolderInbox)
    'Debug.Print vbCr & "** folder: " & fldr

    Set allItems = fldr.items
    allItemsCount = allItems.count
    'Debug.Print "items in folder: " & allItemsCount

    ' ** filter for unread items
    strFilterUnread = "[unread]=true"
    'Debug.Print strFilterUnread

    Set unreadItems = allItems.Restrict(strFilterUnread)
    unreadItemsCount = unreadItems.count
    'Debug.Print "unread items in " & fldr & ": " & unreadItemsCount & vbCr

    ' ** filter for aged items
    strFilterAged = "[ReceivedTime]<'" & Format(Date - 2, "DDDDD HH:NN") & "'"
    'Debug.Print strFilterAged

    Set agedItems = allItems.Restrict(strFilterAged)
    agedItemsCount = agedItems.count
    'Debug.Print "aged items in " & fldr & ": " & agedItemsCount

    Set agedUnreadItems = agedItems.Restrict(strFilterUnread)
    agedUnreadItemsCount = agedUnreadItems.count
    'Debug.Print "aged unread items in " & fldr & ": " & agedUnreadItemsCount & vbCr

    processed = allItemsCount - unreadItemsCount

    strMsg = "Total: " & allItemsCount & vbNewLine & "Processed: " & processed & vbNewLine & _
             "Not processed: " & unreadItemsCount & vbNewLine & "Breached: " & agedUnreadItemsCount

    Debug.Print strMsg & vbCr
    'MsgBox strMsg, vbOKOnly + vbInformation, "Count Selected Outlook Items"
    'Call CreateNewMail(allItemsCount, processed, unreadItemsCount, agedUnreadItemsCount)

End Sub

Answer 2

您需要使用 Items 类的 Find/FindNext 或 Restrict 方法。要计算指定日期范围内的项目，您可以将过滤器应用于 Items 集合，返回一个新集合，其中包含原始集合中与过滤器匹配的所有项目。然后你只需要检查Count 属性。

例如，我注意到以下代码：

For Each olMail In Fldr.Items.Restrict("@SQL=%today(""urn:schemas:httpmail:datereceived"")%")
        j = j + 1
        If olMail.UnRead = True Then

每次循环迭代时，您都会重新应用过滤器并获取新的集合。相反，我建议调用一次Restrict，然后检查Count 属性。

您还需要为搜索词组合属性条件。无需检查循环中的UnRead 属性。

在以下文章中详细了解Restrict 方法：

• How To: Use Restrict method to retrieve Outlook mail items from a folder
• How To: Use Restrict method in Outlook to get calendar items