CODEWITHSUNDEEP
vbaoutlook
user3908189
user3908189

Reputation: 1

Sort email with descending date

I loop through all the emails to find the one with specific subject line.

It always starts from the oldest one and is taking lot of time as mostly the mail required is the latest one.

Dim outMailItem As Outlook.MailItem
Dim inputDate As String, subjectFilter As String
Dim saveInFolder As   String
Dim filesys, newfolder, newfolderpath
OutlookOpened = False
On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set outApp = New Outlook.Application
OutlookOpened = True
End If
On Error GoTo 0

If outApp Is Nothing Then
MsgBox "Cannot start Outlook.", vbExclamation
Exit Sub
End If

Set outNs = outApp.GetNamespace("MAPI")

Set outFolder = outNs.Folders("Personal Folders").Folders("Inbox")  
'Set outFolder = outNs.PickFolder                                   
Set outItems = outFolder.Items

If Not outFolder Is Nothing Then
    outItems.Sort "[ReceivedTime]", False
    For Each outItems In outFolder.Items
        If outItems.Class = Outlook.OlObjectClass.olMail Then

            Set outMailItem = outItems
            randomdate = Format(outMailItem.SentOn, "dd/mm/yy")
            If outMailItem.Subject = subjectFilter Then

                If randomdate = inputDate1 Then

                    Debug.Print outMailItem.Subject
                    For Each outAttachment In outMailItem.Attachments
                        outAttachment.SaveAsFile saveInFolder & outAttachment.Filename
                    Next
                End If
            End If
        End If
    Next

I have tried both True and False with sort order.

Upvotes: 0

Views: 5405

Answers (1)

Dmitry Streblechenko
Dmitry Streblechenko

Reputation: 66286

Why do you need to loop through all items? Use Items.Find/FindNext to find the match on the value of the Subject property.

set outMailItem = outItems.Find("[Subject] = '" & subjectFilter & "'")

If you have multiple matches, you can loop through them all using Findf/FindNext

set outMailItem = outItems.Find("[Subject] = '" & subjectFilter & "'")
while Not (outMailItem  Is Nothing)
  'do something with outMailItem 
  set outMailItem  = outItems.FindNext
wend

Upvotes: 2

Related Questions