CODEWITHSUNDEEP
vbaoutlook
Gandalf
Gandalf

Reputation: 33

Looping and sorting email items

I need to loop in a vba script in Outlook in ascending mode.

I tried several ways but it seems it always loop in descending mode.

Is there a faster way to loop through the email items?

Thanks. The code is something like:

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

Upvotes: 1

Views: 1171

Answers (2)

0m3r
0m3r

Reputation: 12499

for ascending and faster way to loop through the email items-

Try using reverse loop, also Restrict SenderName with your filter ( strFind ) to speed it up

Example would be 

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

Make sure to update %Client1% with correct name

Upvotes: 1

niton
niton

Reputation: 9179

You reverted to processing the "raw" items in the folder rather than the items in the collection. True/False has no impact on the items in the folder.

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

Upvotes: 1

Related Questions