根据主题过滤 Outlook 电子邮件，然后下载附件

Posted 2023-03-30

【中文标题】根据主题过滤 Outlook 电子邮件，然后下载附件

【英文标题】：Filter Outlook emails based on Subject then download attachments

【发布时间】：2015-08-17 16:11:42

【问题描述】：

我正在尝试执行以下操作：

搜索未读邮件 用特定关键字打开那些 从电子邮件中下载附件（如果我也可以过滤附件就好了） 将电子邮件标记为已读。

这就是我正在使用的。

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

    '~~> 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")

        'The above loop begins to read everything that is unread.

        'This is the part that gets tricky
        'Here we need to begin filtering subject headline
        'The line below defines what we are filtering

        strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%sketch%'"

        If filteredItems.count = 0 Then
            Debug.Print "No emails found"
            Found = False
        Else

            '~~> 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

        End If

       '~~> Mark 1st unread email as read
        oOlItm.UnRead = False
        DoEvents
        oOlItm.Save
        Exit For
    Next
End Sub

【问题讨论】：

您定义的 strFilter 只是一个字符串...它实际上并没有过滤您的邮件结果..但是顺便说一句，您发布了您的代码，而不是您遇到的问题.. . 很难猜....

这里有什么问题？你的代码有问题吗？您的代码中缺少什么？

我还在努力，我的问题是让过滤器工作。

【参考方案1】：

根据您的代码结构方式，如果您在第一个过滤器中的每个未读项目上使用 Instr，它可能会起作用。

第二个过滤器更有效。

Sub FilerBySubjectUnreadEmail()

    Dim oOlAp As Object
    Dim oOlns As Object
    Dim oOlInb As Object

    Dim oOlItm As Object
    Dim oOlAtch As Object
    Dim strFilter As String

    Dim objUnreadItems As Items
    Dim filteredItems As Items
    Dim i As Long

    '~~> Get Outlook instance
    On Error Resume Next ' You can use this as there is a purpose
    Set oOlAp = GetObject(, "Outlook.application")
    On Error GoTo 0  ' One line from On Error Resume Next. If say five or more lines you are fired.

    If oOlAp Is Nothing Then Set oOlAp = CreateObject("Outlook.application")

    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    Set objUnreadItems = oOlInb.Items.Restrict("[UnRead] = True")

    '~~> Check if there are unread emails
    If objUnreadItems.count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If

    ' Change sketch to what you are looking for
    strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%sketch%'"

    Set filteredItems = objUnreadItems.Restrict(strFilter)

    If filteredItems.count = 0 Then
        Debug.Print "No emails found with applicable subject"
        Exit Sub

    Else

        For i = filteredItems.count To 1 Step -1

            'Debug.Print i & " - " & filteredItems.count

            '~~> Check if the email actually has an attachment
            Set oOlItm = filteredItems(i)

            If oOlItm.Attachments.count <> 0 Then
                For Each oOlAtch In oOlItm.Attachments
                    Debug.Print oOlItm.Subject
                    Debug.Print oOlAtch.DisplayName
                Next

                '~~> Mark email as read
                filteredItems(i).UnRead = False
                DoEvents

                ' Safest to save the item
                '  in case it is needed
                '  but not necessary with Read/Unread
                ' oOlItm.Save

        Else
            MsgBox oOlItm.Subject & " doesn't have an attachment."

        End If

    Next

    End If

ExitRoutine:
    Set oOlAp = Nothing
    Set oOlns = Nothing
    Set oOlInb = Nothing

    Set oOlItm = Nothing
    Set oOlAtch = Nothing

    Set objUnreadItems = Nothing
    Set filteredItems = Nothing

End Sub