从MS Outlook的未读电子邮件下载附件 [英] Downloading Attachments from Unread Emails of MS Outlook

问题描述

我想从我的MS Outlook下载所有未读邮件的附件。我发现下面提到的代码 StackExchange ，它会从第一个未读电子邮件中下载附件。

I want to download all attachments of Unread emails from my MS Outlook. I found this below mentioned code on StackExchange which downloads attachments from first Unread email.

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

Can any one modify this code so i can apply it on all Unread emails.

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

推荐答案

em> Items.Restrict Method（ Outlook） ，您可能需要为Attachment和UnRead项目设置Filter， Filter =[attachment] = True And [Unread] = True ，然后使用 For ... Next循环回落

示例：

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.Item(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

更清洁，面糊和更快...

Much cleaner, batter & faster...

这篇关于从MS Outlook的未读电子邮件下载附件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！