Office: (Office 2019) VBA Outlook E-Mailvorschau aktualisieren wg. Flag-Text

Hallo Leute,

ich benötige bei einem Problem euer Wissen.

Ich setze in Outlook einen Flag "Erledig" mit einem individuellen Text (= MdName). Allerdingst wird mir dieser Text erst nach einem erneuten Aufruf der Email angezeigt. Wie kann ich mit VBA die Vorschau aktualisieren?

Hier mein funktionierender Code:

Code:

Private Sub Application_ItemLoad(ByVal Item As Object)

  On Error Resume Next
          Dim msg As Outlook.MailItem
          Dim sMdNr As String
          Dim sMdName As String
          Dim iStart As Long
          Dim iEnde As Long


10        If TypeName(Outlook.ActiveExplorer.Selection(1)) = "MailItem" Then
20            If Application.ActiveExplorer.CurrentFolder = "VDL (Elsterbescheide)" Then
30                Set msg = Outlook.ActiveExplorer.Selection(1)

                  If msg.IsMarkedAsTask Then Exit Sub
50                iStart = InStr(1, msg.Body, "(Mandantennummer", vbTextCompare) + Len("Mandantennummer ")
60                iEnde = InStr(iStart, msg.Body, ")", vbTextCompare)
70                sMdNr = Trim(Mid(msg.Body, iStart, iEnde - iStart))

                  If Not IsNumeric(sMdNr) Then Exit Sub

80                sMdName = MdBez(sMdNr, False)
90                With msg
100                   .MarkAsTask olMarkComplete
110                   .FlagRequest = olFlagMarked
120                   .FlagRequest = sMdName
130                   .Save
140               End With
150           End If
160       End If
End Sub

On Error resume ist bewusst gewählt, damit auch Email ohne MdName den Erledigt-Flag erhalten.

Vielen Dank im Voraus.
Gruß Nimrod

 

Hallo Leute,

ich mache mal die Ingrid und teile Euch meine Lösung mit.
Ich habe es jetzt in 2 Schritten gelöst.

1. Bei einkommenden E-Mails wird das Flag gesetzt mit zusätzlichen Text.
2. Im zweiten Schritt wird das Flag automatisch auf erledigt gesetzt, wenn ich mir die E-Mail ansehe. So habe ich alle Informationen ohne irgendeine Mehrarbeit.

Code:

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
          Dim varEntryIDs() As String, objItem As Object
          Dim oMail As MailItem
             
          Dim sMdNr As String
          Dim sMdName As String
          Dim iStart As Long
          Dim iEnde As Long
  
          varEntryIDs = Split(EntryIDCollection, ",")

           For i = 0 To UBound(varEntryIDs)
              Set objItem = Application.Session.GetItemFromID(varEntryIDs(i))
              'wenn Objekt ein Mailitem ist
 
30            If objItem.Class = olMail Then
40                Set oMail = objItem
             
50                If oMail.SenderEmailAddress = "test@absender.de" Then     
60                    iStart = InStr(1, oMail.Body, "(Mandantennummer", vbTextCompare) + Len("Mandantennummer ")
70                    iEnde = InStr(iStart, oMail.Body, ")", vbTextCompare)
80                    sMdNr = Trim(Mid(oMail.Body, iStart, iEnde - iStart))
             
90                    If Not IsNumeric(sMdNr) Then Exit Sub
                 
100                   sMdName = MdBez(sMdNr, False)
110                   With oMail
120                       .MarkAsTask olMarkToday
130                       .FlagRequest = olFlagMarked
140                       .FlagRequest = sMdName
150                       .Save
160                   End With
170               End If
              End If
          Next

End Sub


Private Sub Application_ItemLoad(ByVal Item As Object)

10      On Error Resume Next
          Dim oMail As Outlook.MailItem
          Dim sMdNr As String
          Dim sMdName As String
          Dim iStart As Long
          Dim iEnde As Long

20        If TypeName(Outlook.ActiveExplorer.Selection(1)) = "MailItem" Then
30            If Application.ActiveExplorer.CurrentFolder = "VDL (Elsterbescheide)" Then
40                Set oMail = Outlook.ActiveExplorer.Selection(1)

50                If oMail.FlagStatus = olFlagComplete Or oMail.FlagStatus = olNoFlag Then Exit Sub

                  sMdName = oMail.FlagRequest
110               With oMail
120                   .MarkAsTask olMarkComplete
130                   .FlagRequest = olFlagMarked
                      .FlagRequest = sMdName
150                   .Save
160               End With
170           End If
180       End If
End Sub

So und jetzt muss die Praxis zeigen, ob das auch so funktioniert wie ich es mir vorstellt. In meinem Test's war ich erfolgreich.

Gruß Nimrod

 

Hallo Leute,
also es funktioniert jetzt tadellos; gerade getestet.
Alle eingehenden Emails erhalten ein rotes Flag mit MdName und beim auswählen wird sofort ein Häkchen gesetzt.

Kann man den Beitrag auf erledigt setzten?
Ich habe da nichts gefunden.

Gruß Nimrod