Outlook: Warnung bei Empfänger aus Liste (Update)

Wer kennt das nicht, man schreibt eine Mail, geht auf senden und merkt dann – hoppela – das war der gleiche Name in einem anderen Unternehmen. Damit ging die Mail an einen falschen Empfänger. Heinz Schulz von der Firma Rast und Ruh bekommt nun die Geburtstagsgrüße, die eigentlich für Heinz Schulz von der Firma Nassgeschwitzt gehen sollten. Da mir das tatsächlich schon passiert ist, hab ich mir ein Makro für Outlook geschrieben, welches solche Sachen dann nochmal vor dem Senden abprüft und mich dann darauf hinweist.

Um das Makro einzubinden, einfach in Outlook mit den Tasten Alt + F11 den Makro Editor öffnen und den Code bei ThisOutlookSession einfügen, Mailfilter anpassen und fertig.

Option Explicit


'**************************************************************************************
' Mailfilter
'**************************************************************************************

' Der Mailfilter prüft die Empfängerliste (An, CC, BCC) ob eine der Mailadressen auf
' der Liste steht. Wird eine Mailadresse oder auch Teile davon gefunden, wird eine
' Popup Message ausgelöst, ob die Mail wirklich so versendet werden soll.
' Empfängerliste muss unten eingetragen werden

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim xRecipients As Outlook.Recipients   'Emppfängerliste aus Outlook
Dim xRecipient As Outlook.Recipient     'Einzelne Empfänger
Dim xPos As Integer                     'Gefundene Position
Dim xYesNo As Integer                   'Ergebnis Abfrage Ja/Nein
Dim xAddress As Variant                 'Adressfilter, aktuelle Suche
Dim xAddresses() As Variant             'Adressfilterliste


'Empfängeradressen hier eintragen
'Es wird nach dem Inhalt gesucht
'   "kunibert" würde alle Mails markieren, die Kunibert enthalten
'   "@rasel.eu" würde alle Mails an die Domain @rasel.eu markieren
'   "kunibert@rasel.eu" meldet nur die Mail an diesen Empfänger
'Liste wird mit , getrennt beliebig erweitert
' xAddresses = Array("@domain.de", "mail@adresse.de", "Namen")

' Hier die Filter eintragen
'**************************************************************************************
xAddresses = Array("@rasel.eu", "mail@adresse.de", "Namen")
'**************************************************************************************




On Error Resume Next
If Item.Class <> olMail And Item.Class <> olMeetingRequest Then Exit Sub
Set xRecipients = Item.Recipients

For Each xAddress In xAddresses
    For Each xRecipient In xRecipients
        xPos = InStr(LCase(xRecipient.Address), xAddress)
        If xPos > 0 Then
            xYesNo = MsgBox("Du möchtest eine Mail an den Empänger " & xAddress & "." & vbCrLf & "Möchtest du die Mail wirklich versenden?" _
            , vbYesNo + vbQuestion, "Empfänger auf Warnliste")
            If xYesNo = vbNo Then Cancel = True
        End If
    Next xRecipient
Next xAddress
End Sub


'**************************************************************************************

Ergänzend, da das Makro sonst nur einmal funktioniert:

Das Problem bei Office ist, dass Makros als unsicher eingestuft werden. Man hat jetzt zweierlei Möglichkeiten, entweder die Makrosicherheit soweit runterdrehen, dass alle Makros laufen. Das kann man machen, hat aber den unschönen Nebeneffekt, dass zukünftig auch Schadcode ausgeführt werden kann. Da ich das nicht möchte, gehe ich zu Variante 2 und möchte mein Makro Digital signieren.

Wie das genau geht, ist hier beschrieben
https://support.microsoft.com/de-de/office/digitales-signieren-eines-makroprojekts-956e9cc8-bbf6-4365-8bfa-98505ecd1c01
Wer es nicht ganz so genau haben will, kann hier weiterlesen.

für Win10/Win11 mit Office 365 sieht das so aus. Für alle anderen kann ich nicht sprechen

• den Pfad C:\Program Files\Microsoft Office\root\Office16 öffnen
• Das Programm SELFCERT.EXE starten
• Einen beliebigen Zertifikatsnamen eingeben

• Es kommt die Meldung „erfolgreich erstellt“
• in Outlook nun den Makroeditor starten (Alt + F11)
• Unter Extras -> Digitale Signaturen aufrufen

• Wählen klicken und in dem Fenster das digital Signierte Zertifikat auswählen und mit OK bestätigen
• Jetzt das Projekt speichern und Outlook neu starten
• Es kommt nun ein Hinweis, dass Makros deaktiviert sind weil der Herausgeber nicht authentifiziert werden kann. Das ist bei selbst signierten Zertifikaten richtig so. Um das nicht jedes mal bestätigen zu müssen, wählen wir „allen Dokumenten von diesem Herausgeber vertrauen“ aus

Outlook startet und unser Makro ist aktiv.