Liebe Outlook-VBA-Gemeinde,

ich habe den untenstehenden funktionierenden Code produziert. Seine Funktion: Bei nachverfolgten E-Mails in Outlook (Nachverfolgungs-Flag gesetzt) soll, wenn eine Antwort dazu eintrifft (ereignisgesteuert), automatisch das Nachverfolgungs-Flag entfernt werden. Damit fliegt die E-Mail automatisch bei mir aus der sehr langen Aufgabenliste, was sehr hilfreich ist.

Das Ganze ist aber noch ziemlich langsam, weil sämtliche gesendete Objekte in einer For-Next-Schleife überprüft werden.

Wie kann ich das beschleunigen, indem ich z. B. die Schleife komplett umgehe? Gerne nehme ich noch weitere Tipps zur Beschleunigung entgegen.

Bei der Recherche stieß ich auf folgende zwei Möglichkeiten, die ich aber beide nicht zum Laufen brachte:

'1.
filterCriteria = "[ConversationID] = """ & receivedMail.ConversationID & """ AND [FlagStatus] = " & olFlagMarked
Set sentMail = sentFolder.Items.Restrict(filterCriteria).Item(1)

'2.
Set sentMail = sentFolder.Items.Find("[ConversationID] = '" & receivedMail.ConversationID & "' AND [FlagStatus] = " & olFlagMarked)

Vielen Dank im Voraus für Eure Hilfe! :-)

Sepp123

' In ThisOutlookSession-Modul

Private WithEvents olItems As Outlook.Items

Private Sub Application_Startup()
    ' Variablen initialisieren
    Dim olApp As Outlook.Application
    Dim olNS As Outlook.NameSpace

    Set olApp = Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")

    ' Ereignisprozedur für ankommende E-Mails
    Set olItems = olNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub olItems_ItemAdd(ByVal Item As Object)
    If TypeOf Item Is Outlook.MailItem Then
        Dim receivedMail As Outlook.MailItem
        Dim sentMail As Object
        Dim sentFolder As Outlook.Folder

        Set receivedMail = Item
        Set sentFolder = Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)

        For Each sentMail In sentFolder.Items
            If TypeOf sentMail Is Outlook.MailItem And sentMail.ConversationID = receivedMail.ConversationID And sentMail.FlagStatus = olFlagMarked Then
                sentMail.ClearTaskFlag
                sentMail.Save ' Änderungen speichern
                Exit For
            End If
        Next sentMail

    End If
End Sub