Ordnerauswahl beim Senden

Mit diesem VBA-Code lässt sich ein beliebiger E-Mailordner beim Senden einer E-Mail als Ablage auswählen.

Zur Verwendung dieses Beispiels beachten Sie bitte die wichtigen Hinweise, sowie den Workshop VBA in Outlook® verwenden.

Ab Outlook® 2000

Den 1. Codeteil bitte in ein neues Modul kopieren (Einfügen -> Modul im VBA-Editor):

Option Explicit
 
Public Function SentFolder(ByRef Item As Object) As Boolean
 
    '=====================================================================
    ' Zeigt beim Senden einer E-Mail den Outlook®-Auswahlordner an um die
    ' E-Mail bei Bedarf in einen anderen Ordner als "Gesendete Objekte"
    ' abzulegen.
    ' (c) http://www.outlook-stuff.com
    ' 2008-11-19 Version 1.0.1
    '=====================================================================

    Dim objFolder As Object
 
    '---------------------------------------------------------------------
    ' Obwohl in den Eigenschaften der Hilfe die SaveSentMessageFolder-
    ' eigenschaft auch für Besprechungsanfragen möglich sein sollte, kommt
    ' es bei diesen zu einem Fehler. Daher wird vor der Verwendung dieser
    ' Funktion abgefragt, ob es sich bei dem Item um eine E-Mail handelt.
    '---------------------------------------------------------------------
    If Not Item.Class = olMail Then Exit Function
 
    '---------------------------------------------------------------------
    ' Schleife wird solange durchlaufen, bis ein gültiger Ordner ausgewählt
    ' oder die Auswahl abgebrochen wird.
    '---------------------------------------------------------------------
    Do
 
        '-----------------------------------------------------------------
        ' Ordnerauswahl anzeigen
        '-----------------------------------------------------------------
        Set objFolder = Nothing
        Set objFolder = Outlook.Session.PickFolder
 
        '-----------------------------------------------------------------
        ' Wurde die Auswahl abgebrochen?
        '-----------------------------------------------------------------
        If objFolder Is Nothing Then
            SentFolder = True
            Exit Function
        End If
 
        '-----------------------------------------------------------------
        ' Falscher Ordnertyp ausgewählt?
        '-----------------------------------------------------------------
        If InStr(objFolder.DefaultMessageClass, "IPM.Note") = 0 Then
            Set objFolder = Nothing
            If MsgBox("Bitte wählen Sie einen Ordner für E-Mails aus." _
                , vbCritical + vbOKCancel, "Ablage auswählen") = vbCancel Then
                SentFolder = True
                Exit Function
            End If
        End If
 
        '-----------------------------------------------------------------
        ' Der Posteingang eignet sich nicht als Ablage
        '-----------------------------------------------------------------
        If Not objFolder Is Nothing Then
            If objFolder = Outlook.Session.GetDefaultFolder(olFolderInbox) Then
                If MsgBox("Möchten Sie wirklich die gesendete E-Mail im Posteingang ablegen?" _
                    , vbExclamation + vbYesNo + vbDefaultButton2, "Ablage auswählen") = vbNo Then
                    Set objFolder = Nothing
                End If
            End If
        End If
 
    Loop While objFolder Is Nothing
 
    '---------------------------------------------------------------------
    ' Speicherort der E-Mail festlegen
    '---------------------------------------------------------------------
    Set Item.SaveSentMessageFolder = objFolder
 
    '---------------------------------------------------------------------
    ' Referenz auf Ordner löschen
    '---------------------------------------------------------------------
    Set objFolder = Nothing
 
End Function

Der Aufruf erfolgt aus dem Application_ItemSend-Ereignis im Modul DieseOutlookSitzung. Hierhin kopieren Sie bitte den 2. Codeteil:

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) http://www.outlook-stuff.com
    ' 2008-11-19 Version 1.0.1
    '=====================================================================
       
    '---------------------------------------------------------------------
    ' Ordnerauswahl zum Ablegen der gesendeten Mail anzeigen
    '---------------------------------------------------------------------
    Cancel = SentFolder(Item)
 
    '---------------------------------------------------------------------
    ' Referenz auf E-Mail löschen
    '---------------------------------------------------------------------
    Set Item = Nothing
 
End Sub