Excel Macro以保存Outlook 2010附件，將最早的電子郵件保存為最新的電子郵件

Question

需要將Outlook電子郵件中的excel附件從最早的電子郵件保存到最新的電子郵件，並將電子郵件標記為已讀。 如果有多個未讀電子郵件，則較新的附件將覆蓋較舊的附件。

我每天都會收到許多需要保存的電子郵件才能運行報告。 但是，如果錯過了一個報告，則將其忽略，然后轉到下一個數據集。 以下方法有效，但並不總是先保存最早的方法……它會跳來跳去。

我嘗試了多種選擇來保存最早的文件，但是沒有運氣。 關於如何使它始終如一地使用最早的電子郵件的任何幫助。 謝謝

Sub Save_Attachments()
    Dim olApp As Outlook.Application, olNameSpace As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder, olMail As Outlook.MailItem
    Dim olAttachment As Outlook.Attachment, lngAttachmentCounter As Long
    Dim i As String
On Error GoTo Oooops
    Set olApp = New Outlook.Application
    Set olNameSpace = olApp.GetNamespace("MAPI")
    Set olFolder = olNameSpace.GetDefaultFolder(olFolderInbox).Folders("sub_folder")
    If olFolder Is Nothing Then Exit Sub
    For Each olMail In olFolder.Items
        If olMail.UnRead = True Then
             For Each olAttachment In olMail.Attachments
                lngAttachmentCounter = lngAttachmentCounter + 1
                olAttachment.SaveAsFile ThisWorkbook.Path & "\zzzzz.xls"
            Next olAttachment
        End If
        If olMail.UnRead Then
            olMail.UnRead = False
        End If
    Next olMail
    Exit Sub
Oooops:
    MsgBox Err.Description, vbExclamation, "An error occurred"
End Sub

Answer 1

由於您沒有陳述您嘗試過的選項，所以也許您沒有嘗試過

For j = olFolder.Items.count To 1 Step -1 

這樣的事情。

Option Explicit

 Sub Save_Attachments_ReverseOrder()

    Dim olApp As Outlook.Application, olNameSpace As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim olMail As Object ' <-- olMail is not necessarily a mailitem
    Dim olAttachment As Outlook.attachment, lngAttachmentCounter As Long
    Dim j As Long

    On Error GoTo Oooops

    Set olApp = New Outlook.Application
    Set olNameSpace = olApp.GetNamespace("MAPI")
    Set olFolder = olNameSpace.GetDefaultFolder(olFolderInbox).Folders("sub_folder")

    If olFolder Is Nothing Then Exit Sub

    For j = olFolder.Items.count To 1 Step -1    

        Set olMail = olFolder.Items(j)
        If TypeOf olMail Is mailitem Then
            If olMail.UnRead = True Then

                Debug.Print olMail.subject & " - " & olMail.ReceivedTime

                 'For Each olAttachment In olMail.Attachments
                 '   lngAttachmentCounter = lngAttachmentCounter + 1
                 '   olAttachment.SaveAsFile ThisWorkbook.Path & "\zzzzz.xls"
                 'Next olAttachment

                 olMail.UnRead = False             

            Else

                Debug.Print vbCr & olMail.subject & " - " & olMail.ReceivedTime & " was previously read"

            End If     

        Else

            Debug.Print vbCr & "Current item is not a mailitem."      

        End If      

    Next j

    Exit Sub

Oooops:

    MsgBox Err.Description, vbExclamation, "An error occurred"

End Sub