Set oIncMails = oIncoming.Items

Option Explicit
Sub SaveAttachedItemsFromOutlook()
    Dim objOutlApp As Object, oNSpace As Object, oIncoming As Object
    Dim oIncMails As Object, oMail As Object, oAtch As Object
    Dim IsNotAppRun As Boolean
    Dim sFolder As String, s As String
    'диалог запроса выбора папки с файлами
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    'отключаем обновление экрана, чтобы наши действия не мелькали
    Application.ScreenUpdating = False
    
    'подключаемся к Outlook
    On Error Resume Next
    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 oIncoming = oNSpace.GetDefaultFolder(6)
    'Удаленные ==> GetDefaultFolder(3)
    'Исходящие ==> GetDefaultFolder(4)
    'Отправленные ==> GetDefaultFolder(5)
    'Входящие ==> GetDefaultFolder(6)
    
    'получаем коллекцию писем Входящие(включая подпапки)
    Set oIncMails = oIncoming.Items
    'просматриваем каждое письмо
'    For Each oMail In oIncMails
'        'просматриваем каждое вложение письма
'        For Each oAtch In oMail.Attachments
'            'отбираем только файлы Excel
'            If oAtch Like "*.xl*" Then
'                s = GetAtchName(sFolder & oAtch)
'               oAtch.SaveAsFile s
'            End If
'        Next
'    Next
For xx = 1 To oIncMails.Folders.Count
            If oIncMails.Folders(xx).Name = "с работы файлы." Then
                'здесь уже перебираем все письма этой папки
                For Each oMail In oIncMails.Folders(xx).Items
                      'вызываем приведенную Вами функцию
                      saveAttachtoDisk oMail
                Next
            End If
        Next    'Если приложение Outlook было открыта кодом - закрываем
    If IsNotAppRun Then
        objOutlApp.Quit
    End If
    'очищаем переменные
    Set oIncMails = Nothing
    Set oIncoming = Nothing
    Set oNSpace = Nothing
    Set objOutlApp = Nothing
    'возвращаем ранее отключенное обновление экрана
    Application.ScreenUpdating = True
End Sub
'---------------------------------------------------------------------------------------
' Procedure : GetShName
' Purpose   : Функция получения уникального имени файла
'             если файл с именем s уже есть - добавляет номер в скобках
'---------------------------------------------------------------------------------------
Function GetAtchName(ByVal s As String)
    Dim s1 As String, s2 As String, sEx As String
    Dim lu As Long, lp As Long
    
    s1 = s
    lp = InStrRev(s, ".", -1, 1)
    If lp Then
        sEx = Mid(s, lp)
        s1 = Mid(s, 1, lp - 1)
    End If
    s2 = s
    lu = 0
    Do While (Dir(s2, 16) <> "")
        lu = lu + 1
        s2 = s1 & "(" & lu & ")" & sEx
    Loop
    GetAtchName = s2
End Function