用于提取 Outlook 邮件的日期过滤器

Date filter to extract Outlook mails

我正在尝试为我与公司团队共享的共享邮箱创建票务系统。

我想提取某一天收到的邮件信息。

我创建的日期过滤器:

Sub List_Email_Info()
    
    Dim i As Long     
    Dim OlApp As Outlook.Application
    Dim olNS As Namespace
    Dim olInboxFolder As Outlook.Folder
    Dim olItems As Items
    Dim olMailItem As MailItem
    Dim FilterString As String

    Set ol = New Outlook.Application
    Set olNS = ol.GetNamespace("MAPI")
    Set olInboxFolder = olNS.Folders("xyz.europe@xyz.com").Folders("Inbox")
    Set olItems = olInboxFolder.Items 

    FilterString = "[ReceivedTime] >= 30 - 08 - 2021"

    i = 1

    On Error Resume Next

    For Each olMailItem In olItems.Restrict(FilterString)
    
        Range("email_Date").Offset(i, 0).Value = olItems(i).ReceivedTime
        Range("email_Subject").Offset(i, 0).Value = olItems(i).Subject
        Range("email_Sender").Offset(i, 0).Value = olItems(i).SenderName
        Range("email_Body").Offset(i, 0).Value = olItems(i).Body
    
        i = i + 1

    Next olMailItem

    Sheets("Test").Cells.EntireColumn.AutoFit

    MsgBox "Export complete.", vbInformation

    Set xlWB = Nothing
    Set xlApp = Nothing

    Set olItems = Nothing
    Set olInboxFolder = Nothing
    Set olNS = Nothing

End Sub

过滤日期必须是字符串Items.Restrict method (Outlook).

然后针对错误和拼写错误进行调整:

Sub List_Email_Info()

    Dim i As Long
    Dim OlApp As Outlook.Application
    Dim olNS As Namespace
    Dim olInboxFolder As Outlook.Folder
    Dim olItems As Items
    Dim olMailItem As MailItem
    Dim FilterString As String
    
    Set OlApp = New Outlook.Application
    Set olNS = OlApp.GetNamespace("MAPI")
    Set olInboxFolder = olNS.Folders("xyz.europe@xyz.com").Folders("Inbox") ' Localised.
    Set olItems = olInboxFolder.Items
    
    Const FilterDate As Date = #8/20/2021#
    
    FilterString = "[ReceivedTime] >= '" & Format(FilterDate, "ddddd h:nn") & "'"
    
    For Each olMailItem In olItems.Restrict(FilterString)
        Range("email_Date").Offset(i, 0).Value = olMailItem.ReceivedTime
        Range("email_Subject").Offset(i, 0).Value = olMailItem.Subject
        Range("email_Sender").Offset(i, 0).Value = olMailItem.SenderName
        Range("email_Body").Offset(i, 0).Value = olMailItem.Body
    Next
    
    Sheets("Test").Cells.EntireColumn.AutoFit
    MsgBox "Export complete.", vbInformation
    
    Set olItems = Nothing
    Set olInboxFolder = Nothing
    Set olNS = Nothing
    Set OlApp = Nothing

End Sub

Outlook 根据 Windows 控制面板的区域和语言选项小程序中的时间格式、短日期格式和长日期格式设置评估日期时间值。特别是,Outlook 根据不带秒的指定时间格式评估时间。如果您在日期时间比较字符串中指定秒数,过滤器将不会按预期运行。

虽然日期和时间通常以日期格式存储,但使用 Jet 和 DAV 搜索和定位 (DASL) 语法的过滤器要求将日期时间值转换为字符串表示形式。在 Jet 语法中,日期时间比较字符串应该用双引号或单引号引起来。在 DASL 语法中,日期时间比较字符串应该用单引号括起来。

要确保日期时间比较字符串的格式符合 Microsoft Outlook 的预期,请使用 Visual Basic for Applications Format 函数(或您的编程语言中的等效函数)。以下示例创建一个 Jet 筛选器以查找在 2021 年 6 月 12 日 3:30 P.M 当地时间之前收到的所有项目。

criteria = "[ReceivedTime] < '" & Format("6/12/2021 3:30PM","General Date") & "'"

您也可以通过以下方式指定硬编码日期字符串:

FilterString = "[ReceivedTime] > `30/08/2021`"