Outlook-Betreff reinigen

Worum geht es?

Immer mehr Organisationen gehen dazu über, Mail die von ausserhalb der Organisation kommen mit einem hässlichen Zusatz in der Betreffzeile zu versehen ( "[Externe Mail]:" o.ä.). Hier die notwendigen Schritte um diese Zusätze in Outlook wieder loszuwerden.

Wie funktioniert die Lösung grundsätzlich?

Es wird in Outlook eine neue Regel definiert, die bei jedem eingehenden Mail ein Script startet. Dieses Script löscht die überflüssigen Zusätze aus der Betreffzeile und speichert das so geänderte Mail. Weil in Outlook jedes Mail auch noch in einer sogenannten Konversation gespeichert ist, muss auch der Konversationstitel geändert werden.

Was sind die Caveats dieser Lösung?

• Aus Sicherheitsgründen sind Macros in Outlook per default ausgeschaltet. Damit diese Lösung funktioniert, müssen sie eingeschaltet werden, was ein gewisses Sicherheitsrisiko darstellt.
• Auch das Ausführen von Scripts per Outlook-Regel ist seit einiger Zeit ausgeschaltet und muss mit einem Registry-Eintrag manuell wieder erlaubt werden.
• Damit auch die Konversationen geändert werden, muss auch noch die Library Redemption installiert werden.

VBA-Script zum Ändern des Subjects einer Mail

Public Sub ClearSubject(Item As Outlook.MailItem)
  Dim arr As Variant, i As Long

  'List of phrases to be removed
  arr = Array("RE:", "AW:")

  For i = 0 To UBound(arr)
    Item.Subject = Replace(Item.Subject, arr(i), , "", , vbTextCompare)
  Next
  If Item.Saved = False Then
    Item.Subject = Trim$(Item.Subject)
    Item.Save
  End If
End Sub

Quelle: http://www.vboffice.net/en/developers/remove-text-from-email-subject

Meine derzeitige Lösung (25.12.2021)

Public Sub ClearSubject2021(item As Outlook.MailItem)

    ' Diese Prozedur löscht ein überflüssiges Tag aus der Betreffzeile einer Mail
    ' und ändert auch den Titel der Konversation in Outlook

    Const tag = "[Externe Mail]:"

    ' Wir loggen die Betreffzeile vor der Änderung
    Debug.Print item.Subject

    ' danach ersetzen wir den Text durch nichts
    item.Subject = Replace(item.Subject, tag, "")

    ' Jetzt loggen wir die geänderte Betreffzeile
    Debug.Print item.Subject

    If item.Saved = False Then
        item.Subject = Trim$(item.Subject)
        item.Save
    End If

    'Jetzt müssen wir auch noch den Titel der "Konversation" ändern:

    Dim oNS As Object
    Dim oRDOSess As Object
    Dim oRDOItem As Object

    Dim NewConversationTopic As String

    Set oRDOSess = CreateObject("Redemption.RDOSession")
    Set oNS = Nothing
    Set oNS = Outlook.GetNamespace("MAPI")
    oNS.Logon
    oRDOSess.MAPIOBJECT = oNS.MAPIOBJECT

    Set oRDOItem = oRDOSess.GetMessageFromID(item.EntryID, item.Parent.StoreID)

    Debug.Print oRDOItem.ConversationTopic
    'Apply what modifications to topic you want here - dumb example string manipulation shown
    NewConversationTopic = Replace(oRDOItem.ConversationTopic, tag, "")

    oRDOItem.ConversationTopic = NewConversationTopic
    Debug.Print oRDOItem.ConversationTopic
    oRDOItem.Save

End Sub

Quellen mit Conversation-Änderung

• https://forums.slipstick.com/threads/96679-edit-subject-and-change-conversationtopic-using-vba-and-redemption/
• https://stackoverflow.com/questions/8806882/how-can-i-modify-conversationtopic-so-emails-with-different-subjects-are-put-in

-- BeatDoebeli - 24 Dec 2021