从MS Outlook的未读电子邮件下载附件

Question

我想从我的MS Outlook下载所有未读电子邮件的附件。我在StackExchange找到下面提到的代码，它从第一封未读电子邮件下载附件。

任何人都可以修改此代码，以便我可以将其应用于所有未读电子邮件。

Const olFolderInbox As Integer = 6 
'~~> Path for the attachment 
Const AttachmentPath As String = "C:\" 

Sub DownloadAttachmentFirstUnreadEmail() 
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object 
    Dim oOlItm As Object, oOlAtch As Object 

    '~~> New File Name for the attachment 
    Dim NewFileName As String 
    NewFileName = AttachmentPath & Format(Date, "DD-MM-YYYY") & "-" 

    '~~> Get Outlook instance 
    Set oOlAp = GetObject(, "Outlook.application") 
    Set oOlns = oOlAp.GetNamespace("MAPI") 
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox) 

    '~~> Check if there are any actual unread emails 
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then 
     MsgBox "NO Unread Email In Inbox" 
     Exit Sub 
    End If 

    '~~> Extract the attachment from the 1st unread email 
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True") 
     '~~> Check if the email actually has an attachment 
     If oOlItm.Attachments.Count <> 0 Then 
      For Each oOlAtch In oOlItm.Attachments 
       '~~> Download the attachment 
       oOlAtch.SaveAsFile NewFileName & oOlAtch.Filename 
       Exit For 
      Next 
     Else 
      MsgBox "The First item doesn't have an attachment" 
     End If 
     Exit For 
    Next 
End Sub 

Answer 1

当使用Items.Restrict Method (Outlook)你可能要设置附着和未读邮件过滤器，Filter = "[attachment] = True And [Unread] = True"然后用For...Next and loop backwards

例子：

Option Explicit 
Public Sub Example() 
    '// Declare your Variables 
    Dim olNs As Outlook.NameSpace 
    Dim Inbox As Outlook.MAPIFolder 
    Dim Items As Outlook.Items 
    Dim Item As Outlook.MailItem 
    Dim Atmt As Attachment 
    Dim Filter As String 
    Dim FilePath As String 
    Dim AtmtName As String 
    Dim i As Long 

    '// Set Inbox Reference 
    Set olNs = Application.GetNamespace("MAPI") 
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox) 

    FilePath = "C:\Temp\" 
    Filter = "[attachment] = True And [Unread] = True" 

    Set Items = Inbox.Items.Restrict(Filter) 

    '// Loop through backwards 
    For i = Items.Count To 1 Step -1 
     Set Item = Items(i) 

     DoEvents 

     If Item.Class = olMail Then 
      Debug.Print Item.Subject ' Immediate Window 

      For Each Atmt In Item.Attachments 
       AtmtName = FilePath & Atmt.FileName 
       Atmt.SaveAsFile AtmtName 
      Next 
     End If 
    Next 

    Set Inbox = Nothing 
    Set Items = Nothing 
    Set Item = Nothing 
    Set Atmt = Nothing 
    Set olNs = Nothing 
End Sub 

更清洁，连击&更快...