Thema Datum  Von Nutzer Rating
Antwort
Rot Outlook - Mail-Inhalt beim Senden und Antworten überprüfen
09.07.2019 09:15:51 Sebastian Richter
NotSolved
09.07.2019 14:44:15 Gast21224
NotSolved
09.07.2019 16:43:55 Sebastian Richter
Solved

Ansicht des Beitrags:
Von:
Sebastian Richter
Datum:
09.07.2019 09:15:51
Views:
54
Rating: Antwort:
  Ja
Thema:
Outlook - Mail-Inhalt beim Senden und Antworten überprüfen

Hallo Zusammen,

ich wollte für Outlook ein Makro schreiben, dass das Senden eine E-Mail verhindert, sobald bestimmte Wörter darin auftauchen. Das klappt mit der Funktion Application_ItemSend auch ganz gut - zumindest beim Schreiben einer neuen E-Mail. Über CurrentItem bekomme ich Betreff und E-Mail Inhalt und kann dann, je nachdem ob diese Worte enthalten sind, eine PopUp-Nachricht ausgeben und den Versand mit Cancel = true abbrechen.

Das Problem ist nun, dass der Skript auch beim Antworten auf eine E-Mail laufen soll. Diesmal komme ich über CurrentItem nicht an Betreff und Inhalt der Mail heran. Scheinbar existiert das Objekt an dieser Stelle nicht und ich bekomme einen Laufzeitfehler.

Mit Application.ActiveExplorer.Selection.Item(1) bekomme ich auch nur die Mail, die ich erhalten habe. Ich brauche aber den neuen Betreff und Inhalt, den ich beim Antworten in die Mail schreibe.

Kann mir da jemand weiterhelfen?

Das ist momentan mein Quelltext. Sicherlich sind auch so noch ein paar Sachen die man verbessern kann. Den Laufzeitfehler mit On Error zu umgehen ist nicht gerade sehr sauber. Erstmal müsste ich aber beim Antworten aber an die richten Werte herankommen.

' Suchfunktion zum Finden von Wörtern in einem String
Function FindStr(strAll As String, strPart As String) As Boolean
    Dim x As Boolean
    FindStr = InStr(1, strAll, strPart) > 0
End Function
 
' Funktion die beim Betätigen der Senden-Taste ausgeführt wird
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim NewMail As Outlook.MailItem
    
    On Error Resume Next
    Set NewMail = Application.ActiveInspector.CurrentItem
    If Err.Number > 0 Then
        
    End If
    
    Dim words As Variant
    ' Sperrwörter in Array eintragen
    words = Array("Bilanz", "Gehalt", "Vertraulich", "Lohn")
    Dim element As Variant
    
    Dim y As Boolean
    
    For Each element In words
        ' Betreff auf aktuelles Sperrwort (Arrayelement) überprüfen. Abbruch der Schleife beim Auftauchen eines Wortes
        y = FindStr(NewMail.Subject, CStr(element))
        ' Wurde im Betreff kein gesperrtes Wort gefunden, den Inhalt der E-Mail ebenfalls prüfen
        If y = False Then
            y = FindStr(NewMail.Body, CStr(element))
        End If
        If y = True Then Exit For
    Next element
        
    If y = True Then
        ' Enthält der Betreff ein Sperrwort, Fehlermeldung als Popup ausgeben und Sendevorgang nicht ausführen
        bMessage = "Der Betreff oder Inhaltstext enthält eines oder mehrere der folgenden, gesperrten Wörter: "
        ' Ausgabe der Fehlermeldung und der gesperrten Wörter
        Dim i As Byte
        i = 0
        For Each element In words
            If i = 0 Then
                bMessage = bMessage & " " & CStr(element)
            Else
                bMessage = bMessage & ", " & CStr(element)
            End If
            i = i + 1
        Next element
        MsgBox (bMessage)
        Cancel = True
    End If
 
End Sub

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst genau und ausführlich
  • 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
  • Bitte markieren Sie Ihre Anfrage als erledigt wenn Ihnen geholfen wurde
Thema: Name: Email:

 
 

Thema Datum  Von Nutzer Rating
Antwort
Rot Outlook - Mail-Inhalt beim Senden und Antworten überprüfen
09.07.2019 09:15:51 Sebastian Richter
NotSolved
09.07.2019 14:44:15 Gast21224
NotSolved
09.07.2019 16:43:55 Sebastian Richter
Solved