Public Sub SaveAttachments()
    Dim objOutlApp As Object, oNSpace As Object, oIncoming As Object
    Dim oIncMails As Object, oMail As Object, oAtch As Object, myFolder As Object
    Dim saveFolder As String
    Dim xx As Long
    
    'отключаем обновление экрана, чтобы наши действия не мелькали
    'Application.ScreenUpdating = False
    
    'получаем доступ к Оутлук
    Set objOutlApp = GetObject(, "outlook.Application")
    If objOutlApp Is Nothing Then
        Set objOutlApp = CreateObject("outlook.Application")
        IsNotAppRun = True
    End If
    
    'Получаем доступ к папкам почты
    Set oNSpace = objOutlApp.GetNamespace("MAPI")
    'Подключаемся к папке Входящие
    Set myFolder = oNSpace.GetDefaultFolder(olFolderContacts)
    Set oIncoming = myFolder.Folders("РПРЦ")
    'Удаленные ==> oNSpace.GetDefaultFolder(3)
    'Исходящие ==> oNSpace.GetDefaultFolder(4)
    'Отправленные ==> oNSpace.GetDefaultFolder(5)
    'Входящие ==> oNSpace.GetDefaultFolder(6)
    
    saveFolder = "C:\Payments\"
    'Проверка наличия папки платежей. Если нет, то создаем
    If Dir(saveFolder, vbDirectory) = "" Then
        MkDir saveFolderDorogi
    End If

    On Error GoTo ErrHandler
     
    'получаем коллекцию писем Входящие (включая подпапки)
    Set oIncMails = oIncoming.Items
    'For xx = 1 To oIncMails.Folders.Count
        'If oIncMails.Folders(xx).Name = "РПРЦ" Then
            'здесь уже перебираем все письма этой папки
            For Each oMail In oIncMails.Folders(xx).Items
                If oMail.UnRead Then
                    'вызываем приведенную Вами функцию
                    oMail.SaveAsFile saveFolder & oMail.DisplayName
                End If
            Next
        'End If
    'Next
        
    'очищаем переменные
    Set oIncMails = Nothing
    Set oIncoming = Nothing
    Set oNSpace = Nothing
    Set objOutlApp = Nothing
    'возвращаем ранее отключенное обновление экрана
    'Application.ScreenUpdating = True
    
    'For Each mi In myFolder.Items.Restrict("[Unread]=TRUE")
    '   If mi.Class = olMail Then
    '      If mi.Attachments.Count = 0 Then
    '         For miNum = 1 To mi.Attachments.Count
    '            mi.SaveAsFile saveFolder & mi.DisplayName
    '         Next miNum
    '      End If
    '   End If
    'Next mi
    Exit Sub
     
ErrHandler:
    MsgBox (Err.Description)
    'Debug.Print (Err.Description)
    Debug.Print (Err.Number)
End Sub

Sub FindParentFolder()
  
  Const olFolderInbox = 6
  Dim objOutlApp As Object
  Dim oIncoming As Object
  
  On Error Resume Next
  Set objOutlApp = GetObject(, "Outlook.Application")
  If Err Then Set objOutlApp = CreateObject("Outlook.Application")
  On Error GoTo 0
     
  Set oIncoming = objOutlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders("РПРЦ")
  Debug.Print oIncoming.Items.Count
  ' Дальше - перебор в папке oIncoming

End Sub