Home > Enterprise >  VBA code to run only on latest mail received in folder
VBA code to run only on latest mail received in folder

Time:10-04

How can I update the following VBA code to run only on the last received mail on the folder? Current VBA code runs through the whole folder, which takes some time. Many thanks.

Sub Save_Attachment_GFI()

Dim Olook As Outlook.Application
Dim OMailItem As Outlook.MailItem
Dim ONameSpace As Outlook.Namespace
Dim Fol As Outlook.MAPIFolder
Dim Atmt As Outlook.Attachment
Dim TimeStart, TimeEnd

TimeStart = TimeSerial(8, 0, 0) 'define start and end cutoffs
TimeEnd = TimeSerial(22, 30, 0)

Set Olook = New Outlook.Application
Set OMailItem = Olook.CreateItem(olMailItem)
Set ONameSpace = Olook.GetNamespace("MAPI")
Set Fol = ONameSpace.GetDefaultFolder(olFolderInbox)
Set Fol = Fol.Folders("FFA")
Set Fol = Fol.Folders("FFA GFI")
    
    For Each OMailItem In Fol.Items
        For Each Atmt In OMailItem.Attachments
            Atmt.SaveAsFile "C:XXX" & Atmt.Filename
        Next
    Next
    
If Time > TimeStart And Time < TimeEnd Then
    AutoRefresh Now   TimeSerial(0, 2, 30)
Else
    If Time < TimeStart Then AutoRefresh Date   TimeStart
    If Time > TimeEnd Then AutoRefresh (Date   1)   TimeStart
End If

End Sub

CodePudding user response:

Using the Sort method, you can sort the items by received time, and then run your routine on the first item:

Set Olook = New Outlook.Application
Set OMailItem = Olook.CreateItem(olMailItem)
Set ONameSpace = Olook.GetNamespace("MAPI")
Set Fol = ONameSpace.GetDefaultFolder(olFolderInbox)
Set Fol = Fol.Folders("FFA")
Set FolItems = Fol.Folders("FFA GFI").Items

'sort folder.items by received time (true=descending)
FolItems.Sort "[ReceivedTime]", True

'set the item to extract from as the first in the sorted collection
Set OMailItem = FolItems(1)

For Each Atmt In OMailItem.Attachments
    Atmt.SaveAsFile "C:XXX" & Atmt.Filename
Next

If Time > TimeStart And Time < TimeEnd Then
    AutoRefresh Now   TimeSerial(0, 2, 30)
Else
    If Time < TimeStart Then AutoRefresh Date   TimeStart
    If Time > TimeEnd Then AutoRefresh (Date   1)   TimeStart
End If
  • Related