VBA Download Outlook Attachment by Date-CodePudding

I am new to vba and was wondering if someone could help with the subroutine below. Each day I receive a system generated email with an attachment in my Outlook email account. Trying to create a vba subroutine to download the attachment to a folder on a daily basis. Debug.print shows all mailitems in the folder but when the code is executed, it returns the oldest mailitem. Appreciate any help to modify this subroutine.

Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olfolder As Outlook.MAPIFolder
Dim olItem As Object
Dim Mailitem As Outlook.Mailitem
Dim olAtt As Outlook.Attachment
Dim dt As Date

dt = Format(Now(), "mm/dd/yyyy")


Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olfolder = olNS.GetDefaultFolder(olFolderInbox).Parent.Folders("")

                             
For Each olItem In olfolder.Items
        
        If olItem.Class = olMail Then
        Set Mailitem = olItem
        
                           
        
        For Each olAtt In Mailitem.Attachments
            olAtt.SaveAsFile (Filename) & "\" & Format(Date, "mm/dd/yyyy") & olAtt.Filename
            
        Next olAtt
       

Next olItem

     End If

Set olfolder = Nothing
Set olNS = Nothing
Set olApp = Nothing


End Sub

CodePudding user response：

First of all, iterating over all items in the folder is not really a good idea. An Outlook folder, especially Inbox, may contain a lot of items which takes much time to iterate through all of them. So, instead, you need to use the Find/FindNext or Restrict methods of the Items class. In that case you could deal only with items that correspond to your search criteria, for example, items that were received during last two days (or day, it is up to you). Read more about these methods in the following articles:

Also you may take a look at the Filtering Items Using a Date-time Comparison article which can help you to build a search criteria.

but when the code is executed, it returns the oldest mailitem

If you just need to get the latest items in the loop you can sort the collection before iterating over all items. The Items.Sort method sorts the collection of items by the specified property.

Dim inboxItems as Outlook.Items 

Set inboxItems = olfolder.Items

inboxItems.Sort "[ReceivedTime]", False

For Each olItem In inboxItems

CodePudding user response：

Looks like the most recent attachment is being overwritten. You could apply Exit For to stop after the first save.

If you find it is unreliable in your code:

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant


Private Sub AttachementFromMostRecentMailInFolder()

Dim olFolder As Folder
Dim olFolderItems As Items

Dim olMitem As Mailitem

Dim olAtt As Attachment
Dim dt As Date

dt = Format(Now(), "mm/dd/yyyy")
Debug.Print dt

Dim filePath As String
filePath = CStr(Environ("USERPROFILE")) & "\Documents"
Debug.Print filePath

' Folder at same level as Inbox
Set olFolder = Session.GetDefaultFolder(olFolderInbox).Parent.Folders("Test")
Set olFolderItems = olFolder.Items
olFolderItems.Sort "[ReceivedTime]", True

Dim i As Long

' Typically there would be at least one condition on olFolderItems
'  to identify applicable mail
'  sender or subject or both or other

For i = 1 To olFolderItems.count
            
    If olFolderItems(i).Class = olMail Then
       
        Set olMitem = olFolderItems(i)
        
        If olMitem.Attachments.count > 0 Then
        
            For Each olAtt In olMitem.Attachments
                Debug.Print filePath & "\" & Format(Date, "mm/dd/yyyy") & olAtt.fileName
                olAtt.SaveAsFile filePath & "\" & Format(Date, "mm/dd/yyyy") & olAtt.fileName
            Next olAtt
            
            ' Process one item only
            '  or most recent will be overwritten
            Exit For
        
        End If
        
        Set olMitem = Nothing
        
    End If
        
Next i

End Sub