Thema Datum  Von Nutzer Rating
Antwort
Rot Nachverfolgungs-Flag automatisch löschen
30.07.2024 08:06:15 Sepp123
NotSolved
07.08.2024 21:16:45 Gast81460
NotSolved
08.08.2024 09:11:20 Sepp123
NotSolved
08.08.2024 13:01:41 ralf_b
NotSolved

Ansicht des Beitrags:
Von:
Sepp123
Datum:
30.07.2024 08:06:15
Views:
516
Rating: Antwort:
  Ja
Thema:
Nachverfolgungs-Flag automatisch löschen

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

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Nachverfolgungs-Flag automatisch löschen
30.07.2024 08:06:15 Sepp123
NotSolved
07.08.2024 21:16:45 Gast81460
NotSolved
08.08.2024 09:11:20 Sepp123
NotSolved
08.08.2024 13:01:41 ralf_b
NotSolved