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

Question

需要将Excel电子邮件中的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