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
    
    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 = oNSpace.Folders(1).Folders("РПРЦ")
    
    saveFolder = "C:\Payments\"
    If Dir(saveFolder, vbDirectory) = "" Then
        MkDir saveFolderDorogi
    End If

    On Error GoTo ErrHandler
     
    Set oIncMails = oIncoming.Items
    For Each oMail In oIncMails
        If oMail.UnRead Then
            For Each oAtch In oMail.Attachments
                oAtch.SaveAsFile saveFolder & oAtch.DisplayName
            Next
        End If
    Next
    
    Set oIncMails = Nothing
    Set oIncoming = Nothing
    Set oNSpace = Nothing
    Set objOutlApp = Nothing
    
    Exit Sub
     
ErrHandler:
    MsgBox (Err.Description)
    'Debug.Print (Err.Description)
    Debug.Print (Err.Number)
End Sub

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

ThisWorkbook.Sheets("Лист1").Range("A9:B15").Copy oSheet.Range("B2")

Sub Forma_5_Create()
 Dim oBook, oSheet ' Application Excel, Book, Sheet
 Set oBook = Workbooks.Open("D:\Riz\2020\Ïðèëîæåíèå 5.xlsx")
 Set oSheet = oBook.Sheets(1)
 
 ThisWorkbook.Sheets("Лист1").Range([A9], [B9].End(xlDown)).Copy oSheet.[D2]
 oBook.Save
 oBook.Close
End Sub

Sub Forma_5_Create()
    Dim oBook, oSheet ' Application Excel, Book, Sheet
    Set oBook = Workbooks.Open("D:\Riz\2020\Ïðèëîæåíèå 5.xlsx")
    Set oSheet = oBook.Sheets(1)
    
    ThisWorkbook.Sheets("Лист1").Range("A9:B15").Copy _
        Destination:=oSheet.Range("D2")
    oBook.Save
    oBook.Close
End Sub

Sub Forma_5_Create()
    Dim oBook, oSheet ' Application Excel, Book, Sheet
    Set oBook = Workbooks.Open("D:\Riz\2020\Приложение 5.xlsx")
    Set oSheet = oBook.Sheets(1)
    
    ThisWorkbook.Sheets("Лист1").Select
    Range("A9:B9").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    oSheet.Select
    Range("D6").Select
    ActiveSheet.Paste
    oBook.Save
    oBook.Close
End Sub

Dim oAppExcel, oBook, oSheet
Set oAppExcel = CreateObject("Excel.Application")
Set oBook = oAppExcel.Workbooks.Open("D:\Riz\2020\Приложение 5.xlsx")
Set oSheet = oBook.Sheets(1)

Sheets("Лист2").Select
Range("C1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
oSheet.Select
Range("I6").Select
ActiveSheet.Paste