Question

我需要以升序模式在Outlook中循环vba脚本。

我尝试了几种方法，但它似乎总是以降序模式循环。

是否有更快的方式来浏览电子邮件项目？

感谢。代码类似于：

Public Sub CheckClient()
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim items As Outlook.items
Dim strFind As String
Dim Item

Set objNS = GetNamespace("MAPI")
Set objFolder = objNS.PickFolder()

strFind = "[ReceivedTime] >= '05/15/2017' AND [ReceivedTime] < '05/16/2017'"

Set items = objFolder.items
items.Sort "[ReceivedTime]", True

Set items = objFolder.items.Restrict(strFind)

For Each Item In objFolder.items
    If TypeName(Item) = "MailItem" Then

            If Item.Sender = "Client1"  Then
                DBInsert (Item)
            End if
Next
End Sub

Answer 1

你又回来了处理＆＃34; raw＆＃34;文件夹中的项目而不是集合中的项目。 True / False对文件夹中的项目没有影响。

Sub CheckClient()

Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim items As Outlook.items

Dim strFind As String
Dim Item As Object
Dim resItems As items

Set objNS = GetNamespace("MAPI")
Set objFolder = objNS.PickFolder()

strFind = "[ReceivedTime] >= '05/15/2017' AND [ReceivedTime] < '05/16/2017'"

Set items = objFolder.items

items.Sort "[ReceivedTime]", True
For Each Item In items
    If TypeName(Item) = "MailItem" Then
        Debug.Print Item.ReceivedTime & ": " & Item.Subject
    End If
Next

Debug.Print

Set resItems = objFolder.items.Restrict(strFind)
' False should sort in reverse order of True
resItems.Sort "[ReceivedTime]", False

' Process resItems not the entire folder
For Each Item In resItems
    If TypeName(Item) = "MailItem" Then
        Debug.Print Item.ReceivedTime & ": " & Item.Subject
    End If
Next
End Sub

Answer 2

以递增和更快的方式循环浏览电子邮件 -

尝试使用反向循环，同时使用您的过滤器（SenderName）限制strFind以加快速度

示例将是

Option Explicit
Public Sub CheckClient()
    Dim objFolder As Outlook.MAPIFolder
    Dim Items As Outlook.Items
    Dim strFind As String
    Dim Recived As Long
    Dim i As Long

    Set objFolder = Application.Session.PickFolder
    Set Items = objFolder.Items
        Items.Sort "[ReceivedTime]"

    strFind = "@SQL=" & Chr(34) & "urn:schemas:httpmail:datereceived" & _
                        Chr(34) & " >= '05/15/2017' AND " & _
                        Chr(34) & "urn:schemas:httpmail:datereceived" & _
                        Chr(34) & " < '05/16/2017' AND " & _
                        Chr(34) & "urn:schemas:httpmail:fromname" & _
                        Chr(34) & "Like '%Client1%'"

    Set Items = objFolder.Items.Restrict(strFind)

    For i = Items.Count To 1 Step -1
        DoEvents
        Debug.Print Items(i).SenderName 'Immediate Window
        Debug.Print Items(i).ReceivedTime 'Immediate Window
    Next

    Set objFolder = Nothing
    Set Items = Nothing
End Sub

确保使用正确的名称更新 %Client1%

循环和排序电子邮件项目

2 个答案: