Empfängerabhängige Mailkopie (BCC)

Mit dem folgenden Code kann nur für bestimmte Empfänger (strRecipients) eine Mailkopie an strBCC gesendet werden:

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).

Ab Outlook® 2000

Option Explicit
 
Public Function MailCopy(ByRef Item As Object) As Boolean
 
    '=====================================================================
    ' Sendet eine Mailkopie (an "strBCC") nur bei bestimmten Empfängern
    ' ("strRecipients").
    ' (c) Peter Marchert - http://www.outlook-stuff.com
    ' 2008-11-21 Version 1.0.0
    '=====================================================================
    
    Dim objRecipient As Outlook.Recipient    ' Einzelner Empfänger
    Dim objBCC As Outlook.Recipient          ' BCC-Empfänger
    Dim strBCC As String                     ' Adresse des BCC-Empfängers
    Dim strRecipients As String              ' Adressen der Empfänger
    Dim blnFound As Boolean                  ' Empfänger in E-Mail enthalten
    
    '---------------------------------------------------------------------
    ' Einstellungen vornehmen
    '---------------------------------------------------------------------
    strBCC = "bcc@server.de"
    strRecipients = "empfaenger1@server.de;empfaenger2@server.de"
 
    '---------------------------------------------------------------------
    ' Ist einer der Empfänger in der E-Mail enthalten?
    '---------------------------------------------------------------------
    For Each objRecipient In Item.Recipients
        If InStr(strRecipients, objRecipient.Address) Then blnFound = True
    Next
 
    '---------------------------------------------------------------------
    ' Wurde einer der Empfänger gefunden?
    '---------------------------------------------------------------------
    If blnFound Then
        Set objBCC = Item.Recipients.Add(strBCC)
        objBCC.Type = olBCC
        objBCC.Resolve
        MailCopy = IIf(objBCC.Resolved, False, True)
    End If
 
    '---------------------------------------------------------------------
    ' Referenz auf BCC-Empfänger löschen
    '---------------------------------------------------------------------
    Set objBCC = Nothing
 
    '---------------------------------------------------------------------
    ' Referenz auf Empfänger löschen
    '---------------------------------------------------------------------
    Set objRecipient = Nothing
 
End Function

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 senden
    '---------------------------------------------------------------------
    Cancel = MailCopy(Item)
 
    '---------------------------------------------------------------------
    ' Referenz auf E-Mail löschen
    '---------------------------------------------------------------------
    Set Item = Nothing
 
End Sub
 

Siehe auch Beitrag Funktionen kombinieren