Suche nach Ordner nach Schlüssel in Thema

Question

Ich muss die eingehende Nachricht in den zugehörigen Ordner abhängig von einem Schlüssel im Betreff der Nachricht verschieben.

Ich entwickelte ein Skript, um den Schlüssel in das Thema der neuen Nachricht zu bekommen. Wie kann ich Rest von Nachrichten durch einen Schlüssel suchen und verwandten Ordner abrufen?

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 

der unbekannte Teil, Suche alle Ordner mit Schlüssel und Abrufen der zugehörigen Ordner

strFolder = "???" 

und schließlich die eingehende Nachricht an den zugehörigen Ordner unter 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 

Ich bewege bin neu in VBA.

Answer 1

Dies durchsucht Ordner rekursiv nach einem Objekt.

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