Search for folder by key in subject

Question

I need to move the incoming message to the related folder depending on a key in the subject of the message.

I developed a script for getting the key in the subject of new message. How can I search rest of messages by a key and retrieve related folder?

Sub CustomMailMessageRule(Item As Outlook.MailItem)
    Dim strTicket, strSubject As String 
    Dim strFolder As String
    strTicket = "None"
    strSubject = Item.Subject
    If InStr(1, strSubject, "#-") > 0 Then
        strSubject = Mid(strSubject, InStr(strSubject, "#-") + 2)
        If InStr(strSubject, " ") > 0 Then
            strTicket = Left(strSubject, InStr(strSubject, " ") - 1)
        End If
    End If

the unknown part, search all folders by key and retrieve the related folder

 strFolder = "???"

and finally, move the incoming message to the related folder by below code

    If InStr(strFolder) > 0 Then
        Item.Move Session.GetDefaultFolder(olFolderInbox).folders(strFolder)

    MsgBox "Your New Message has been moved to related folder "  
End Sub

I'm new in VBA.

You don't need VBA for this. Use Rules to move your messages: https://support.office.com/en-us/article/Manage-email-messages-by-using-rules-c24f5dea-9465-4df4-ad17-a50704d66c59 — , Sep 30 '17 at 11:56
The key is not unique and need to check in my folders to find rest of the loop — epjtester, Sep 30 '17 at 12:18
Take a look at https://stackoverflow.com/questions/2272361/can-i-iterate-through-all-outlook-emails-in-a-folder-including-sub-folders Once you find an applicable oMail, oParent is the folder. — niton, Oct 02 '17 at 18:48
@niton tnx, but I cant get the point of the code, how it works, how can I pass my key(from the subject of the new message) and search in folders and find the related folder. — epjtester, Oct 06 '17 at 04:58
Reread the question and this describes methods for searching https://stackoverflow.com/questions/21549938/vba-search-in-outlook without going through every item and every folder. — niton, Oct 06 '17 at 09:59
Dear @niton, thank you, but I have 2 question, 1. how it can work whenever I receive the new message. 2. how it work search on folders, it seems it works only for Inbox, I have several inboxes which may my new message loop is in one of them and I need move the new message to a related folder. — epjtester, Oct 09 '17 at 03:01

score 0 · Answer 1 · answered Jan 02 '18 at 22:22

This searches folders recursively for an item by subject.

Option Explicit

Sub CustomMailMessageRule(Item As mailItem)

    Dim strSubject As String
    Dim strDynamic As String
    Dim strFilter As String

    Dim originFolder As Folder
    Dim startFolder As Folder
    Dim uPrompt As String

    strSubject = Item.subject

    Set startFolder = Session.GetDefaultFolder(olFolderInbox)

    ' To reference any inbox not specifically the default inbox
    'Set startFolder = Session.folders("email address").folders("Inbox")

    Set originFolder = startFolder

    ' For testing the mail subject is "This is a test"
    If InStr(1, strSubject, "This is") > 0 Then

        ' For testing the dynamically determined key is "a test"
        strDynamic = "a test"

        strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " LIKE '%" & strDynamic & "%'"
        Debug.Print strFilter

        ' Advanced search requires "Scope" to be specified so it appears
        '  not easy/possible to process every subfolder in the way described here
        ' https://stackoverflow.com/questions/43638711/outlook-macro-advanced-search

        '  This recursively processes every subfolder
        processFolder originFolder, startFolder, strFilter, Item

        uPrompt = "Mail with " & strDynamic & " in subject not found in subfolders of " & startFolder.Name
        Debug.Print uPrompt
        MsgBox uPrompt

    End If

ExitRoutine:
    Set startFolder = Nothing

End Sub

Private Sub processFolder(ByVal originFolder As Folder, ByVal oParent As Folder, strFilter As String, oIncomingMail As mailItem)

    Dim oFolder As Folder
    Dim oObj As Object
    Dim filteredItems As items

    Dim uResp As VbMsgBoxResult

    Debug.Print oParent

    If originFolder.EntryID <> oParent.EntryID Then

        ' This narrows the search.
        ' https://stackoverflow.com/questions/21549938/vba-search-in-outlook
        Set filteredItems = oParent.items.Restrict(strFilter)

        If filteredItems.count > 0 Then

            Debug.Print oParent
            Debug.Print "Mail found in " & oParent.Name

            uResp = MsgBox(Prompt:="Move Message to folder: " & oParent.Name & "?", _
              Buttons:=vbYesNoCancel)

            If uResp = vbYes Then
                oIncomingMail.move oParent
                End
            End If

            If uResp = vbCancel Then End

        End If

    End If

    If (oParent.folders.count > 0) Then
        For Each oFolder In oParent.folders
            processFolder originFolder, oFolder, strFilter, oIncomingMail
        Next
    End If

End Sub

Search for folder by key in subject

1 Answers1