Hi RP,

I haven't try this code maybe this helps.

Sub GetAttachments()
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
i = 0

If Inbox.Items.Count = 0 Then
   MsgBox "There are no messages in the Inbox.", vbInformation, _
          "Nothing Found"
   Exit Sub
End If

For Each Item In Inbox.Items
   For Each Atmt In Item.Attachments
      FileName = "C:\Email Attachments\" & Atmt.FileName
      Atmt.SaveAsFile FileName
      i = i + 1
   Next Atmt
Next Item

If i > 0 Then
   MsgBox "I found " & i & " attached files." _
      & vbCrLf & "I have saved them into the C:\Email Attachments folder." _
      & vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
Else
   MsgBox "I didn't find any attached files in your mail.", vbInformation, _
   "Finished!"
End If

GetAttachments_err:
  MsgBox "An unexpected error has occurred." _
     & vbCrLf & "Please note and report the following information." _
     & vbCrLf & "Macro Name: GetAttachments" _
     & vbCrLf & "Error Number: " & Err.Number _
     & vbCrLf & "Error Description: " & Err.Description _
     , vbCritical, "Error!"
  Resume GetAttachments_exit

GetAttachments_exit:
  Set Atmt = Nothing
  Set Item = Nothing
  Set ns = Nothing
  Exit Sub

End Sub

For Each Item In Inbox.Items
  For Each Atmt In Item.Attachments
     If Right(Atmt.FileName, 3) = "xls" Then
        FileName = "C:\Email Attachments\" & Atmt.FileName
        Atmt.SaveAsFile FileName
        i = i + 1
     End If
  Next Atmt
Next Item

Dim SubFolder As MAPIFolder

Set SubFolder = Inbox.Folders("Sales Reports")

If SubFolder.Items.Count = 0 Then
  MsgBox "There are no messages in the Sales Reports folder." _
  , vbInformation, "Nothing Found"
  Exit Sub
End If
If SubFolder.Items.Count > 0 Then
  For Each Item In SubFolder.Items
     For Each Atmt In Item.Attachments
        FileName = "C:\Email Attachments\" & Atmt.FileName
        Atmt.SaveAsFile FileName
        i = i + 1
     Next Atmt
  Next Item
End If