Question

我正在使用以下For Each循环将新的Outlook邮件导入Excel。我正在尝试加快例程，并且无法将此过滤器应用于现有代码。

myInbox.Items.Restricted("DateValue[ReceivedTime] > "" & Format(DateValue(Now, "ddddd h:nn AMPM") & "")

有人可以提供一些指示吗？提前致谢！

Dim myOlApp As New Outlook.Application
Dim myNameSpace As Outlook.Namespace
Dim myInbox As Outlook.Items
Dim myitems As Outlook.Items
Dim myitem As Object
Dim Found As Boolean

Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myInbox = myNameSpace.Session.Folders.Item("test@test.com").Folders("My Folder").Items
' Need to apply filter to only pull items new than a specified date'
Found = False
       For Each myitem In myInbox
                 'This next line is checking all items in folder which is taking too long'
        If myitem.Class = olMail And myitem.ReceivedTime > Workbooks("Test.xlsm").Sheets("Sheet1").Range("C2").Value Then
               'Do something'
                Found = True
        End If
 Next myitem
 Set myOlApp = Nothing

Answer 1

为什么要对DateValue进行痴迷？

这是错误的Format(DateValue(Now, "ddddd h:nn AMPM")，这是"DateValue[ReceivedTime]

即使您更正了该syantax，您也试图设置一个大于当前时间的过滤器，因此您试图限制尚未收到的项目：）

使用变量存储特定时间（早于当前日期时间）

以下代码会过滤11/4/2017 10:25:00 PM之后收到的所有商品

Sub test()

    Dim myOlApp As New Outlook.Application
    Dim myNameSpace As Outlook.NameSpace
    Dim myInbox As Outlook.Items
    Dim myItems As Outlook.Items
    Dim myitem As Object
    Dim Found As Boolean
    Dim TimeCrit    As Date

    TimeCrit = #11/4/2017 10:25:00 PM#

    Set myNameSpace = myOlApp.GetNamespace("MAPI")
    Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox).Items
    ' Need to apply filter to only pull items new than a specified date'
    Set myItems = myInbox.Restrict("[ReceivedTime] >= """ & Format(TimeCrit, "ddddd h:nn AMPM") & """")

    Found = False
    For Each myitem In myItems
        MsgBox myitem.Subject
    Next myitem
    Set myOlApp = Nothing


End Sub

如何根据收到的时间对邮件项目应用过滤器？

1 个答案: