How to Search Items with Attachment and keyword in

Question

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

e.g. Sub: training_24357 on one day and training_24359 on the next day.

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

below is my code.

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

Answer 1

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

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 Example https://stackoverflow.com/a/42547062/4539709 Or https://stackoverflow.com/a/42777485/4539709

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 Event Occurs when one or more Items are added to the specified collection. This event does not run when a large number of items are added to the folder at once.}

---

Code Example:

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