Макрос Outlook для прочтения и сохранения писем

Sub SaveAattachments(myItem As Outlook.MailItem)
 
'Sub SaveAattachments()
 
Dim oNameSpace As NameSpace
Dim oFolder As MAPIFolder
'Dim MI As MailItem
Dim MI
Dim DestFolder As String
Dim i As Integer
 
    Set oNameSpace = ThisOutlookSession.Session
    Set oFolder = oNameSpace.GetDefaultFolder(olFolderInbox)
    
    If Len(Dir("L:\Карты\CardPL\Files\In\")) = 0 Then
 
        DestFolder = "C:\Card_In\"
    Else
        DestFolder = "L:\Карты\CardPL\Files\In\"
    End If
        
    For Each MI In oFolder.Items
        If MI.UnRead = True Then
        If MI.Attachments.Count > 0 Then
            For i = 1 To MI.Attachments.Count
                MI.Attachments.Item(i).SaveAsFile DestFolder & MI.Attachments.Item(i).DisplayName
            Next
        End If
        MI.UnRead = False
        End If
    Next
End Sub

Option Explicit
'http://stackoverflow.com/questions/11781320/ _
         download-attachment-from-outlook-and-open-in-excel
 
Const olFolderInbox As Integer = 6
'~~> Path for the attachment
Const AttachmentPath As String = "G:\Вложения\"
 
Sub DownloadAttachment()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object, oOlAtch As Object
    '~~> New File Name for the attachment
    Dim NewFileName As String
    NewFileName = AttachmentPath & Format(Date, "DD-MM-YYYY") & "-"
 
    '~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
 
    '~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "Нет новых сообщений"
        Exit Sub
    End If
 
    '~~> Extract the attachment from the 1st unread email
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
        '~~> Check if the email actually has an attachment
        If oOlItm.Attachments.Count <> 0 Then
            For Each oOlAtch In oOlItm.Attachments
                '~~> Download the attachment
                oOlAtch.SaveAsFile NewFileName & oOlAtch.FileName
'                Exit For
            Next
        ' Else
            ' MsgBox "The First item doesn't have an attachment"
        End If
        Exit For
    Next
 End Sub