AF-Network

Hat man im Outlook mehr als ein Postfach eingebunden und schreib nun eine Mail mit dem Absender eines der „neben“ Postfächer, dann landet die gesendet Mail im eigenen Ordner „Gesendete Objekte„.

Wie kommt die gesendete Mail ohne manuelles zutun nun in das richtige Postfach und dort in die „Gesendete Objekte„?

Dafür hilft folgendes VBA Script. Dazu den VBA Editor mit ALT+F11 aufrufen und „DieseOutlookSitzung“ im Projekt Explorer auswählen. Danach den folgenden Inhalt hinzufügen. Die Variable strNameSendFolder muss noch angepasst werden. Hier kann „Gesendete Elemente“ oder „Gesendete Objekte“ stehen oder jeder andere beliebige Ordner im entsprechenden Postfach.

Public WithEvents mySentItems As Items

Sub Application_startup()

  Set mySentItems = Application.GetNamespace("MAPI").GetDefaultFolder _
(olFolderSentMail).Items

End Sub

Private Sub mySentItems_ItemAdd(ByVal Item As Object)
'Gesendete Objekte weitere Postfächer kopieren
On Error GoTo Fehler

Dim olItem As MailItem
Dim olNameSpace As Outlook.NameSpace
Dim olMAPIFolder As Outlook.MAPIFolder
Dim oCurrentUser As Object
Dim strSenderUser As String
Dim strSenderUserMAPIFolder As String
Dim strNameSendFolder As String
Set olNameSpace = Application.GetNamespace("MAPI")

'####################################################################################
' Bitte anpassen. Muss der Name des Ordners sein, in dem die Mail kopiert werden soll
'####################################################################################
strNameSendFolder = "Gesendete Elemente"

If (Item.Class = olMail) Then
    Set oCurrentUser = olNameSpace.CurrentUser
    If (Item.SentOnBehalfOfName = oCurrentUser) Then
        Exit Sub
    Else
        Set olCopiedItem = Item.Copy
        strSenderUser = Item.SentOnBehalfOfName
        strSenderUserMAPIFolder = "Postfach - " & strSenderUser
        Set olMAPIFolder = olNameSpace.Folders(strSenderUserMAPIFolder)
        olCopiedItem.Move olMAPIFolder.Folders(strNameSendFolder)
        olCopiedItem.Save
        Exit Sub
    End If
Else
    Exit Sub
End If

Fehler:
'MsgBox "Es ist ein Fehler aufgetreten." & Chr$(13) & _
'"Die Nachricht wurde in ihren Gesendeten Objekten gespeichert.", _
'vbCritical + vbOKOnly, "Es ist ein Fehler aufgetreten!"

End Sub

Nun Outlook neustarten. Danach werden die Mails in den Postausgangsordner des Absenders kopiert.

Update 2012-02-27:
Danke an Daniel für den Tipp mit den Registry Eintrag.

Hier ist der KB Artikel von Microsoft: http://support.microsoft.com/kb/972148/de
Und hier der Artikel von Daniel: http://www.dalecom.de/gesendete-objekte-im-erweiterten-postfach/