Загрузка приложений Outlook

Question

Можно ли изменить мой код, чтобы загрузить самое последнее вложение от определенного отправителя, а не все вложения в моем почтовом ящике?

Private Sub GetAttachmentstttt()
Dim ns As NameSpace
Dim Inbox As Outlook.MAPIFolder
Dim Item As Object
Dim Atmt As Outlook.Attachment
Dim FileName As String

Set ns = GetNamespace("MAPI")
Set Inbox = ns.Folders("xx@gmail.com").Folders("Inbox")


If Inbox.Items.Count = 0 Then
    MsgBox "There are no messages in the Inbox.", vbInformation, _
            "Nothing Found"
    Exit Sub
End If

For Each Item In Inbox.Items
    For Each Atmt In Item.Attachments
        If Atmt.Type = 1 And InStr(Atmt, "xls") > 0 Then
            FileName = "C:\downloads" & Atmt.FileName
            Atmt.SaveAsFile FileName
        End If
    Next Atmt
Next Item
End Sub

Answer 1

Для ограничения отправителя.

Option Explicit

Private Sub GetAttachments_SenderRestrict()

Dim inboxFolder As folder

Dim itm As Object
Dim itms As Items
Dim resItms As Items

Dim j As Long

Dim atmt As Attachment
Dim fileName As String

Dim srchSender As String
Dim strFilter As String

'Set inboxFolder = Session.folders("xx@gmail.com").folders("Inbox")
Set inboxFolder = Session.GetDefaultFolder(olFolderInbox)
Set itms = inboxFolder.Items

If itms.Count = 0 Then
    MsgBox "There are no messages in the Inbox.", vbInformation, "Nothing Found"
    Exit Sub
End If

Debug.Print vbCr & "itms.Count: " & itms.Count

srchSender = ActiveInspector.CurrentItem.senderName

strFilter = "[SenderName] = '" & srchSender & "'"
Debug.Print vbCr & strFilter

Set resItms = itms.Restrict(strFilter)
If resItms.Count = 0 Then
    MsgBox "No " & srchSender & " email."
    Exit Sub
End If
Debug.Print "resitms.Count: " & resItms.Count

'For Each itm In resItms
'    Debug.Print itm.Subject
'Next itm

resItms.sort "[ReceivedTime]", True
For j = 1 To resItms.Count
    Debug.Print resItms(j).ReceivedTime & ": " & resItms(j).Subject
Next j

' resItms(1) should be the most recent mail
Debug.Print vbCr & "resItms(1)"
Debug.Print resItms(1).ReceivedTime & ": " & resItms(1).Subject

For Each atmt In resItms(1).Attachments
    If atmt.Type = 1 And InStr(atmt, "xls") > 0 Then
        'Filename = "C:\downloads" & Atmt.Filename
        fileName = "C:\downloads" & "\" & atmt.fileName
        atmt.SaveAsFile fileName
    End If
Next atmt

Debug.Print "Done."

End Sub