Excel 宏保存 Outlook 2010 附件，最旧的电子邮件到最新的电子邮件答案

【问题标题】：Excel Macro to Save Outlook 2010 attachment, oldest email to newest emailExcel 宏保存 Outlook 2010 附件，最旧的电子邮件到最新的电子邮件
【发布时间】：2014-04-11 16:42:33
【问题描述】：

需要将 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

【问题讨论】：

标签： excel vba outlook

【解决方案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

【讨论】：