Загрузите файл Excel из последней электронной почты в папку «Входящие» Outlook, используя Excel VBA

Question

Я получаю отчет раз в неделю в виде приложения в формате Excel (.xlsm).Мне нужно получить доступ к последней электронной почте, затем загрузить приложение Excel и сохранить его по определенному пути на моем рабочем столе.

Почтовый ящик называется «ACBS MIS Reports», а вложение всегда называется «Отчет по ACBS LC».для AMLS - месяц DD ".Это всегда будет последнее электронное письмо (в верхней части почтового ящика), которое меня интересует.

Этот код возвращает сообщение об ошибке, как написано внизу кода в «GetAttachments_err».

Sub GetAttachments()
' This Outlook macro checks a the Outlook Inbox for messages
' with attached files (of any type) and saves them to disk.
' NOTE: make sure the specified save folder exists before
' running the macro.

On Error GoTo GetAttachments_err

'Declare Variables

Dim ns As Namespace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
i = 0

'Check Inbox for messages and exit if none found

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

' Check each message for attachments

For Each Item In Inbox.Items
'Save any attachments found
    For Each Atmt In Item.Attachments
    ' This path must exist! Change folder name as necessary.
        FileName = "C:\Users\jalanger\Desktop\Letters of Credit\Macro Work\Test" & Atmt.DisplayName
        Atmt.SaveAsFile FileName
        i = i + 1
     Next Atmt
Next Item

' Show summary message
If i > 0 Then
    MsgBox "I found " & i & " attached files." _
    & vbCrLf & "I have saved them into the C:\Email Attachments folder." _
    & vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
Else
    MsgBox "I didn't find any attached files in your mail.", vbInformation, "Finished!"
End If
'Clear memory
GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub

'Handle errors
GetAttachments_err:
MsgBox "An unexpected error has occurred." _
    & vbCrLf & "Please note and report the following information." _
    & vbCrLf & "Macro Name: GetAttachments" _
    & vbCrLf & "Error Number: " & Err.Number _
    & vbCrLf & "Error Description: " & Err.Description _
    , vbCritical, "Error!"
Resume GetAttachments_exit
End Sub

Answer 1

Редактировать Макрос был отредактирован для запуска из Excel, а не из Outlook.Он использует раннее связывание, поэтому вам нужно будет установить ссылку на библиотеку объектов Outlook (VBE >> Инструменты >> Ссылки >> и выбрать библиотеку объектов Microsoft Outlook).

Фильтр первого макроса следующего фильтраэлементы из папки «Входящие» на основе указанного имени отправителя затем сортируют их по полученному времени и в порядке убывания, а затем получают первый элемент из отфильтрованного и отсортированного списка.Наконец, он сохраняет указанное вложение, если оно существует.Обратите внимание, что если файл с таким же именем, что и вложение, уже существует, существующий файл будет перезаписан.Измените сохранение в папку, имя отправителя и имя вложения, где указано.

Option Explicit

Sub GetLatestReport()

    'Set a reference to Outlook's object library (Visual Basic >> Tools >> References >> check/select Microsoft Outlook Object Library)

    Dim outlookApp              As Outlook.Application
    Dim outlookInbox            As Outlook.MAPIFolder
    Dim outlookRestrictItems    As Outlook.Items
    Dim outlookLatestItem       As Outlook.MailItem
    Dim outlookAttachment       As Outlook.Attachment
    Dim attachmentFound         As Boolean

    Const saveToFolder          As String = "C:\Users\Domenic\Desktop" 'change the save to folder accordingly
    Const senderName            As String = "SenderName" 'change the sender name accordingly
    Const attachmentName        As String = "AttachmentName" 'change the attachment name accordingly

    'Create an instance of Outlook
    Set outlookApp = New Outlook.Application

    'Get the inbox from Outlook
    Set outlookInbox = outlookApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

    'Filter the items from the inbox based on the sender
    Set outlookRestrictItems = outlookInbox.Items.Restrict("[SenderName] = '" & senderName & "'")

    'Check whether any items were found
    If outlookRestrictItems.Count = 0 Then
        MsgBox "No items were found from " & senderName & "!", vbExclamation
        Exit Sub
    End If

    'Sort the filtered items by received time and in descending order
    outlookRestrictItems.Sort Property:="[ReceivedTime]", Descending:=True

    'Get the latest item from the filtered and sorted items
    Set outlookLatestItem = outlookRestrictItems(1)

    'Loop through each attachment from the latest item until specified file is found
    attachmentFound = False
    For Each outlookAttachment In outlookLatestItem.Attachments
        If Left(UCase(outlookAttachment.Filename), Len(attachmentName)) = UCase(attachmentName) Then
            outlookAttachment.SaveAsFile saveToFolder & "\" & outlookAttachment.DisplayName
            attachmentFound = True
            Exit For
        End If
    Next outlookAttachment

    If attachmentFound Then
        MsgBox "The attachment was found and saved to '" & saveToFolder & "'!", vbInformation
    Else
        MsgBox "No attachment was found!", vbExclamation
    End If

End Sub