Ordner mit Kopie gleichzeitig erstellen

Mit diesem Codebeispiel ist es möglich, einen gewünschten Ordner gleichzeitig im Posteingang und im Ordner Gesendete Objekte zu erstellen.

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 CreateFolders()
 
    '=====================================================================
    ' Erstellt im "Posteingang" und im Ordner "Gesendete Objekte" gleich-
    ' zeitig einen Ordner
    ' (c) Peter Marchert - http://www.outlook-stuff.com
    ' 2008-11-21 Version 1.0.0
    '=====================================================================
 
    Dim objInBox As Object
    Dim objSent As Object
    Dim strFolderName As String
 
    '---------------------------------------------------------------------
    ' Ordner "Posteingang" und "Gesendete Objekte" referenzieren
    '---------------------------------------------------------------------
    Set objInBox = Outlook.Session.GetDefaultFolder(olFolderInbox)
    Set objSent = Outlook.Session.GetDefaultFolder(olFolderSentMail)
 
    '---------------------------------------------------------------------
    ' Ordnernamen eingeben
    '---------------------------------------------------------------------
    strFolderName = InputBox("Bitte Ordnernamen eingeben:", _
        "Ornder erstellen (Posteing. und Gesendete Objekte)")
 
    '---------------------------------------------------------------------
    ' Abbruch oder leerer Name -> Sub beenden
    '---------------------------------------------------------------------
    If Trim(strFolderName) = "" Then Exit Sub
 
    '---------------------------------------------------------------------
    ' Falls der Ordner schon existiert gibt es sonst eine Fehlermeldung
    '---------------------------------------------------------------------
    On Error Resume Next
 
    '---------------------------------------------------------------------
    ' Ordner erstellen
    '---------------------------------------------------------------------
    Call objInBox.Folders.Add(strFolderName)
    Call objSent.Folders.Add(strFolderName)
 
    '---------------------------------------------------------------------
    ' Referenz auf Posteingang löschen
    '---------------------------------------------------------------------
    Set objInBox = Nothing
 
    '---------------------------------------------------------------------
    ' Referenz auf Ordner "Gesendete Objekte" löschen
    '---------------------------------------------------------------------
    Set objSent = Nothing
 
End Sub