Betreff und Anhang auf Vorhandensein prüfen

Mit dem folgenden Makro wird in Outlook 2002 jede ausgehende Mail dahingehend
überprüft, ob
- ein Betreff vorhanden ist und
- ggf. erforderliche Attachments angehängt wurden.

Um das Makro zu installieren in Outlook den Visual Basic Editor aufrufen (ALT-F11)
und den unten stehende Makro-Code in das Modul DieseOutlookSitzung kopieren. 

Das Makro befindet sich bei mir mit Outlook 2002 täglich im erfolgreichen Einsatz.
(Es müsste aber auch unter Outlook 2000 und 2003 funktionieren.) Die Verantwortung 
für den Einsatz trägt trotzdem jeder Nutzer selbst. Aus der Nutzung des Makros können
keine Ansprüch jedweder Art geltend gemacht werden.
Das Makro darf beliebig kopiert und geändert werden. Kosten oder Gebühren für die 
Weitergabe oder Zurverfügungstellung dürfen nicht geltend gemacht werden.

Funktionsweise:
Die Prüfung auf einen fehlenden Betreff ist recht unspannend.
Ob möglicherweise Attachments fehlen, wird anhand von Schlüsselworten im Mailtext
entschieden. Die Schlüsselworte werden in der Funktion NeedsAttachment im 
Stringarray sPhrases verwaltet und können jederzeit angepaßt oder ergänzt werden.
Taucht eines der Schlüsselworte im Mail-Text auf, wird geprüft, ob ein Attachment 
vorhanden ist. Wenn nein, wird nachgefragt, ob die Mail trotzdem versendet werden
soll.


---------- Beginn Makro-Code -----------------------------

Option Base 1


Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    Dim bHasAttach As Boolean
    Dim Prompt As String
    
    
    ' sicherstellen, dass nur MailItems untersucht werden
    If Item.Class = olMail Then
        
        ' prüfen auf leeren Betreff
        If Item.Subject = "" Then
            Prompt = "Die Mail an >" & Item.To & "< hat keinen Betreff. Trotzdem senden?"
            If MsgBox(Prompt, vbYesNo + vbQuestion, "leerer Betreff") = vbNo Then
                Cancel = True
            End If
        End If
    
        
        ' prüfen, ob möglicherweise ein Attachment erforderlich, aber nicht vorhanden ist
        If NeedsAttachment(Item.Body) Then
            bHasAttach = True
            If TypeName(Item.Attachments) = "Nothing" Then
                bHasAttach = False
            Else
                If Item.Attachments.Count = 0 Then
                    bHasAttach = False
                End If
            End If
            If Not bHasAttach Then
                Prompt = "In der Mail >" & Item.Subject & "< fehlt möglicherweise ein Anhang. Trotzdem senden?"
                If MsgBox(Prompt, vbYesNo + vbQuestion, "fehlender Anhang") = vbNo Then
                    Cancel = True
                End If
            End If
        End If
    
    End If 'Item.Class = olMail
    
End Sub


Private Function NeedsAttachment(ByVal text As String) As Boolean

    Dim sPhrases As Variant
    Dim sTe As String
    Dim bNAtta As Boolean
    Dim i As Integer, iu As Integer
    
    ' Prüfstrings initialisieren
    sPhrases = Array( _
                "siehe anhang", _
                "s. anhang", _
                "s.anhang", _
                "siehe anlage", _
                "s. anlage", _
                "s.anlage", _
                "siehe anhängende datei", _
                "s. anhängende datei", _
                "siehe beigefügte datei", _
                "s. beigefügte datei", _
                "anbei")
    
    sTe = LCase(text)
    bNAtta = False
    iu = UBound(sPhrases)
    For i = 1 To iu
        If InStr(sTe, sPhrases(i)) <> 0 Then
            bNAtta = True
            Exit For
        End If
    Next
    
    NeedsAttachment = bNAtta
End Function

---------- Ende Makro-Code -----------------------------