Vba 循环和排序电子邮件项目

我需要在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

公共子检查客户端（）
将对象设置为Outlook.NameSpace
将objFolder设置为Outlook.MAPIFolder
将项目设置为Outlook.items
Dim strFind As字符串
暗项
设置objNS=GetNamespace（“MAPI”）
设置objFolder=objNS.PickFolder（）
strFind=“[ReceivedTime]>='2017年5月15日'和[ReceivedTime]<'2017年5月16日'
Set items=objFolder.items
items.Sort“[ReceivedTime]”，True
Set items=objFolder.items.Restrict（strFind）
对于objFolder.items中的每个项目
如果TypeName（Item）=“MailItem”，则
如果Item.Sender=“Client1”，则
数据库插入（项目）
如果结束
下一个
端接头

您已恢复处理文件夹中的“原始”项目，而不是集合中的项目。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

子检查客户端（）
将对象设置为Outlook.NameSpace
将objFolder设置为Outlook.MAPIFolder
将项目设置为Outlook.items
Dim strFind As字符串
将项目变暗为对象
将大小项设置为项目
设置objNS=GetNamespace（“MAPI”）
设置objFolder=objNS.PickFolder（）
strFind=“[ReceivedTime]>='2017年5月15日'和[ReceivedTime]<'2017年5月16日'
Set items=objFolder.items
items.Sort“[ReceivedTime]”，True
对于项目中的每个项目
如果TypeName（Item）=“MailItem”，则
Debug.Print Item.ReceivedTime&“：”和Item.Subject
如果结束
下一个
调试。打印
设置resItems=objFolder.items.Restrict（strFind）
'False应按与True相反的顺序排序
resItems.Sort“[ReceivedTime]”，False
'进程不会调整整个文件夹的大小
对于resItems中的每个项目
如果TypeName（Item）=“MailItem”，则
Debug.Print Item.ReceivedTime&“：”和Item.Subject
如果结束
下一个
端接头

以提升和更快的方式循环浏览电子邮件项目-

尝试使用反向循环，同时使用过滤器（

strFind

）限制

SenderName

）以加快速度

例如

选项显式
公共子检查客户端（）
将objFolder设置为Outlook.MAPIFolder
将项目设置为Outlook。项目
Dim strFind As字符串
我受的时间很长
我想我会坚持多久
设置objFolder=Application.Session.PickFolder
Set Items=objFolder.Items
Items.Sort“[ReceivedTime]”
strFind=“@SQL=“&Chr（34）”和“urn:schemas:httpmail:datereceived”和_
Chr（34）和“>=”2017年5月15日“和”&_
Chr（34）&“urn:schemas:httpmail:datereceived”&_
Chr（34）和“<'05/16/2017'和”&_
Chr（34）&“urn:schemas:httpmail:fromname”&_
Chr（34）&类似于“%Client1%”
Set Items=objFolder.Items.Restrict（strFind）
对于i=项目。计数为1步骤-1
多芬特
Debug.Print Items（i）.SenderName即时窗口
调试.打印项目（i）.接收时间'即时窗口
下一个
设置objFolder=Nothing
设置项=无
端接头

确保使用正确的名称更新

%Client1%

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