VBA – Outlook Makro vor dem Absenden einer E-Mail ausführen

Um vor dem Senden einer Nachricht ein VBA-Script ausführen zu können, wird im speziellen Outlook Modul ThisOutlookSession die Funktion Application_ItemSend genutzt. Hier wird beispielhaft ein Script gezeigt, welches auf das Vorhandensein von externen Empfängern prüft und gewarnt, sobald ein externer Empfänger in der Adressatenliste (To, CC, BCC) vorhanden ist.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim prompt As String
Dim recv As String
recv = ""

'Listet alle Empfänger aus To, CC und BCC auf
For i = 1 To Item.Recipients.Count
    If InStr(vbNull, Item.Recipients.Item(i).Address, "/O=DOMAIN", vbTextCompare) = 0 Then
        If InStr(vbNull, Item.Recipients.Item(i).Address, "@domain.de", vbTextCompare) = 0 Then
            recv = recv & vbCrLf & Item.Recipients.Item(i) & "<" & Item.Recipients.Item(i).Address & ">"
        End If
    End If
Next

'Das hier sind nur Strings, ohne weitere Eigenschaften
'recv = recv & vbCrLf & Item.TO
'recv = recv & vbCrLf & Item.CC
'recv = recv & vbCrLf & Item.BCC

If Len(recv) > 0 Then
    'prompt = "E-Mail """ & Item.Subject & """ an folgende Empfänger wirklich senden?" & vbCrLf & recv
    prompt = "Diese Mail enthält die folgenden externen Empfänger" & vbCrLf & recv & vbCrLf & vbCrLf & "Wollen Sie die Mail wirklich senden?"

    If MsgBox(prompt, vbYesNo + vbQuestion, "Mail an externe(n) Empfänger bestätigen") = vbNo Then
        Cancel = True
    End If
End If
End Sub