Sub НомерПапкиУчетки()

   Dim x, xx
   Dim oNspace As Outlook.NameSpace
   Set oNspace = Application.GetNamespace("MAPI")
    For x = 1 To oNspace.Folders.Count
        Debug.Print oNspace.Folders(x).Name & " ==> " & x
        For xx = 1 To oNspace.Folders(x).Folders.Count
            Debug.Print vbTab & oNspace.Folders(x).Folders(xx).Name & " ==> " & xx
        Next
        Debug.Print "============== "
    Next
End Sub

Public Sub ruleAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
    
saveFolder = "C:\Test\"
'dateFormat = Format(Now, "yyyy-mm-dd H-mm") 'если нужно сделать так, чтобы все приходящие файлы записывалось с разными именами

' проверяем есть ли на компе папка saveFolder , если её нет,то создаем
If Dir(saveFolder, vbDirectory) = "" Then
     MkDir saveFolder
End If
    
     For Each objAtt In itm.Attachments
          If objAtt.fileName Like "*.xl*" Then ' если вложение Экселевский файл , то записываем его в папку saveFolder
          'objAtt.SaveAsFile saveFolder & dateFormat & objAtt.fileName 'если нужно сделать так, чтобы все приходящие файлы записывалось с разными именами
          objAtt.SaveAsFile saveFolder & objAtt.fileName
          End If
     Next
     Set objAtt = Nothing
End Sub