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).
Ab Outlook® 2000
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