title: VBA: Only save the last (The most recent) email attachment in a local folder
body: <p>I need to save the attachment of last email that has a specific subject (the most recent one) to a local folder, to do this I have created a folder in my Outlook and a rule to send every email with that specific subject to this folder. I have found a code that does what I needed except that it saves every single attachment in the email folder rather than saving only the most recent one. This is the code: how could i modify it so that it does what i need?</p>
  
  <pre><code>   Sub Test()
     'Arg 1 = Folder name of folder inside your Inbox
     'Arg 2 = File extension, "" is every file
     'Arg 3 = Save folder, "C:\Users\Ron\test" or ""
     '        If you use "" it will create a date/time stamped folder for you in your "Documents" folder
  '        Note: If you use this "C:\Users\Ron\test" the folder must exist.
  
      SaveEmailAttachmentsToFolder "Dependencia Financiera", "xls", "W:\dependencia financiera\test dependencia\"
  
  End Sub
  
  
  
  Sub SaveEmailAttachmentsToFolder(OutlookFolderInInbox As String, _
                                   ExtString As String, DestFolder As String)
      Dim ns As NameSpace
      Dim Inbox As MAPIFolder
      Dim SubFolder As MAPIFolder
      Dim Item As Object
      Dim Atmt As Attachment
      Dim FileName As String
      Dim MyDocPath As String
      Dim i As Integer
      Dim wsh As Object
      Dim fs As Object
  
      On Error GoTo ThisMacro_err
  
      Set ns = GetNamespace("MAPI")
      Set Inbox = ns.GetDefaultFolder(olFolderInbox)
      Set SubFolder = Inbox.Folders(OutlookFolderInInbox)
  
      i = 0
      ' Check subfolder for messages and exit of none found
      If SubFolder.Items.Count = 0 Then
          MsgBox "There are no messages in this folder : " &amp; OutlookFolderInInbox, _
                 vbInformation, "Nothing Found"
          Set SubFolder = Nothing
          Set Inbox = Nothing
          Set ns = Nothing
          Exit Sub
      End If
  
      'Create DestFolder if DestFolder = ""
     ' If DestFolder = "" Then
         ' Set wsh = CreateObject("WScript.Shell")
         ' Set fs = CreateObject("Scripting.FileSystemObject")
         ' MyDocPath = wsh.SpecialFolders.Item("mydocuments")
         ' DestFolder = MyDocPath &amp; "\" &amp; Format(Now, "dd-mmm-yyyy hh-mm-ss")
         ' If Not fs.FolderExists(DestFolder) Then
              'fs.CreateFolder DestFolder
         ' End If
      'End If
  
      'If Right(DestFolder, 1) &lt;&gt; "\" Then
          'DestFolder = DestFolder &amp; "\"
      'End If
  
      ' Check each message for attachments and extensions
      'JUST BEED TGE FIRST EMAIL
      'Debug.Print Item(1).SentOn
  
      For Each Item In SubFolder.Items
         For Each Atmt In Item.Attachments
              If LCase(Right(Atmt.FileName, Len(ExtString))) = LCase(ExtString) Then
                  FileName = DestFolder &amp; Atmt.FileName
                  Atmt.SaveAsFile FileName
                  'I = I + 1
              End If
         Next Atmt
     Next Item
  
      ' Show this message when Finished
     ' If I &gt; 0 Then
         ' MsgBox "You can find the files here : " _
               &amp; DestFolder, vbInformation, "Finished!"
     ' Else
         ' MsgBox "No attached files in your mail.", vbInformation, "Finished!"
     ' End If
  
      ' Clear memory
  ThisMacro_exit:
      Set SubFolder = Nothing
      Set Inbox = Nothing
      Set ns = Nothing
      Set fs = Nothing
      Set wsh = Nothing
      Exit Sub
  
      ' Error information
  ThisMacro_err:
      MsgBox "An unexpected error has occurred." _
           &amp; vbCrLf &amp; "Please note and report the following information." _
           &amp; vbCrLf &amp; "Macro Name: SaveEmailAttachmentsToFolder" _
           &amp; vbCrLf &amp; "Error Number: " &amp; Err.Number _
           &amp; vbCrLf &amp; "Error Description: " &amp; Err.Description _
           , vbCritical, "Error!"
      Resume ThisMacro_exit
  
  End Sub
  </code></pre>