Mailkopie mit geändertem Betreff

Die Funktion Immer BCC hat den Nachteil, dass die Betreffzeile nicht geändert werden kann, da nur 1 E-Mail zum Mailserver übertragen und dort die Verteilung an alle Empfänger vorgenommen wird.

Mit dem folgenden Code können Sie automatisch eine Mailkopie (ohne Anlagen) an eine feste E-Mailadresse mit einem Präfix vor dem Betreff senden.

Zur Verwendung dieses Beispiels beachten Sie bitte die wichtigen Hinweise, sowie den Workshop VBA in Outlook® verwenden. Den Code bitte in ein neues Modul kopieren (Einfügen -> Modul im VBA-Editor).

Für Outlook® 2000, Outlook® 2002, Outlook® 2003, Outlook® 2007

Option Explicit
 
Public Sub MailCopyChangedSubject(ByRef Item As Object)
 
    '=====================================================================
    ' Sendet alle E-Mails an eine weitere Adresse und setzt auf Wunsch
    ' ein Schlüsselwort vor den Betreff.
    ' (c) Peter Marchert - http://www.outlook-stuff.com
    ' 2008-11-21 Version 1.0.0
    '=====================================================================
 
    Dim objMailItem As Outlook.MailItem   ' Neue E-Mail
    Dim strAddToSubject As String         ' Kopieempfänger
    Dim strRecipient As String            ' Wort, das dem Betreff
                                          ' vorangestellt wird
    Dim blnSecret As Boolean              ' Speichern einer Kopie verhindern
 
    '---------------------------------------------------------------------
    ' Einstellungen vornehmen
    '---------------------------------------------------------------------
    strRecipient = "empfaenger@server.de"
    strAddToSubject = "Mailkopie an extern"
    blnSecret = True
 
    '---------------------------------------------------------------------
    ' Neue E-Mail erstellen
    '---------------------------------------------------------------------
    Set objMailItem = Outlook.CreateItem(olMailItem)
 
    '---------------------------------------------------------------------
    ' Mailkopie erstellen und anpassen
    '---------------------------------------------------------------------
    With objMailItem
        .To = strRecipient
        .Body = Item.Body & vbCrLf & vbCrLf & _
            "Diese E-Mail wurde an folgende Empfänger versendet:" & _
            vbCrLf & "An: " & Item.To & vbCrLf & "CC: " & Item.CC & _
            vbCrLf & "BCC: " & Item.BCC
        If Trim(strAddToSubject) <> "" Then
            .Subject = strAddToSubject & " " & Item.Subject
        End If
        If blnSecret Then .DeleteAfterSubmit = True
        .Send
    End With
 
    '---------------------------------------------------------------------
    ' Refernz auf neue E-Mail löschen
    '---------------------------------------------------------------------
    Set objMailItem = Nothing
 
End Sub

Der Aufruf erfolgt aus dem Modul DieseOutlookSitzung im Application_ItemSend-Ereignis:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
 
    '=====================================================================
    ' Diese Prozedur wird unmittelbar vor dem Senden einer E-Mail aufge-
    ' rufen. Ist "Cancel" wahr, wird das Senden der E-Mail abgebrochen.
    ' (c) Peter Marchert - http://www.outlook-stuff.com
    ' 2008-11-21 Version 1.0.0
    '=====================================================================
 
    '---------------------------------------------------------------------
    ' Automatisch eine Mailkopie mit geändertem Betreff senden
    '---------------------------------------------------------------------
    Call MailCopyChangedSubject(Item)
 
    '---------------------------------------------------------------------
    ' Referenz auf E-Mail löschen
    '---------------------------------------------------------------------
    Set Item = Nothing
 
End Sub

Siehe auch Beitrag Funktionen kombinieren