如何使用过滤器在主题中搜索带有附件和关键字的项目 [英] How to Search Items with Attachment and keyword in Subject using Filter

问题描述

我正在编写一个代码，该附件将通过主题过滤器下载到与主题相关的上下文中的文件夹位置.

I am working on a code which attachment will be download to folder location in context to subject by using a subject filter.

经过长时间的互联网搜索，我的代码可以正常工作，但是这里的问题是我想将关键字放入主题过滤器中，以便随着主题每天都在变化，它会下载附件

After a long search on the internet, my code is working but the problem here is that I want to put the keyword in the subject filter so that it will download the attachment as the subject keep changing every day

例如一天Sub: training_24357，第二天training_24359.

此外，我想每5分钟自动运行一次代码，我们将不胜感激

Also, I want to run my code after every 5 minutes automatically, any help will be much appreciated,

下面是我的代码.

Sub Attachment()

    Dim OutOpened As Boolean
    Dim App As Outlook.Application
    Dim Ns As Outlook.NameSpace
    Dim Folder As Outlook.MAPIFolder
    Dim Attach As Outlook.Attachment
    Dim Item As Object
    Dim MailItem As Outlook.MailItem
    Dim subject As String
    Dim saveFolder As String
    Dim dateFormat As String

    saveFolder = "D:\Outlook\POS Visit Report"
    If Right(saveFolder, 1) <> "\" Then saveFolder = saveFolder & "\"

        subject = """*POS Visit*"""

        OutOpened = False
        On Error Resume Next
        Set App = GetObject(, "Outlook.Application")
        If Err.Number <> 0 Then
            Set App = New Outlook.Application
            OutOpened = True
        End If
   On Error GoTo 0
        If App Is Nothing Then
            MsgBox "Cannot Start Outlook Mail", vbExclamation
            Exit Sub
        End If
    Set Ns = App.GetNamespace("MAPI")
    Set Folder = Ns.GetDefaultFolder(olFolderInbox)

        If Not olFolder Is Nothing Then
            For Each Item In olFolder.Items
                If Item.Class = Outlook.ObjectClass.olMail Then
                    Set MailItem = Item
                    If MailItem.subject = subject Then
                        Debug.Print MailItem.subject
                        For Each Attach In MailItem.Attachments
                        dateFormat = Format(Now(), "yyyy-mm-dd H-mm")
                        Attach.SaveAsFile saveFolder & "(" & dateFormat & ")" & " " & Attach
                        Next
                    End If
                End If
            Next
        End If


    If OutOpened Then App.Quit
    Set App = Nothing

End Sub

推荐答案

要搜索带有附件的项目，并按主题行，您可以使用

To Search for Items with Attachment and by Subject line you can use Items.Restrict Method to filter Items collection containing all the match from the filter

过滤器示例: [Attachment & Subject Like '%training%']

Filter Example: [Attachment & Subject Like '%training%']

Filter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & _
                   Chr(34) & " Like '%training%' AND " & _
                   Chr(34) & "urn:schemas:httpmail:hasattachment" & _
                   Chr(34) & "=1"

VBA示例 https://stackoverflow.com/a/42547062/4539709或 https://stackoverflow.com/a/42777485/4539709

现在，如果您从Outlook运行代码，则无需GetObject或Set App = New Outlook.Application只需Set Ns = Application.GetNamespace("MAPI")

Now if your running the code from Outlook then you do not need to GetObject, or Set App = New Outlook.Application Just simply Set Ns = Application.GetNamespace("MAPI")

在将项目添加到收件箱时运行代码收件箱-尝试使用

To run your code when Items are added to you Inbox - Try working with Application.Startup Event (Outlook) And Items_ItemAdd Event (Outlook)

_{Items.ItemAdd事件在将一个或多个Item添加到指定的集合时发生.一次将大量项目添加到文件夹时，此事件不会运行.}

---

代码示例:

Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
    Dim olNs As Outlook.NameSpace
    Dim Inbox  As Outlook.MAPIFolder

    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    Set Items = Inbox.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)    
    If TypeOf Item Is Outlook.MailItem Then
        '// call sub here
    End If
End Sub

这篇关于如何使用过滤器在主题中搜索带有附件和关键字的项目的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！