Wie können verschiedene Arten gelöschter Elemente in Outlook automatisch in unterschiedliche Ordner verschoben werden?

In Outlook werden alle Arten von gelöschten Elementen – wie E-Mails, Aufgaben, Kontakte usw. – in den Ordner „Gelöschte Elemente“ verschoben. Wie können Sie diese Elemente basierend auf ihrem Typ in separate Unterordner innerhalb des „Gelöschte Elemente“-Ordners verschieben, wie im folgenden Screenshot dargestellt?

---

Verschiedene Arten von Gelöschte Elemente mithilfe von VBA-Code automatisch in unterschiedliche Ordner verschieben

Der folgende VBA-Code unterstützt Sie dabei, gelöschte Elemente automatisch in verschiedene Ordner zu verschieben. Gehen Sie dazu wie folgt vor:

1. Starten Sie Outlook und halten Sie anschließend die Tasten ALT + F11 gedrückt, um das Fenster Microsoft Visual Basic for Applications zu öffnen.

2. Doppelklicken Sie nun im Bereich ThisOutlookSession unter Projekt – Projekt1, und fügen Sie anschließend den folgenden Code in das leere Codefenster ein:

VBA-Code: Verschiedene Arten von Gelöschte Elemente automatisch in unterschiedliche Ordner verschieben

Public WithEvents GDeletedFolder As Outlook.Folder
Public WithEvents GDeletedItems As Outlook.Items
Private Sub Application_Startup()
  Set GDeletedFolder = Application.Session.GetDefaultFolder(olFolderDeletedItems)
  Set GDeletedItems = GDeletedFolder.Items
End Sub
Private Sub GDeletedItems_ItemAdd(ByVal Item As Object)
'Updateby ExtendOffice
Dim xTargetFolder As Outlook.Folder
On Error Resume Next
Select Case TypeName(Item)
  Case "MailItem", "PostItem", "ReportItem", "MeetingItem"
    Set xTargetFolder = GDeletedFolder.Folders("Deleted Mails")
    If xTargetFolder Is Nothing Then
      Set xTargetFolder = GDeletedFolder.Folders.Add("Deleted Mails", olFolderInbox)
    End If
  Case "AppointmentItem"
    Set xTargetFolder = GDeletedFolder.Folders("Deleted Appointments")
    If xTargetFolder Is Nothing Then
      Set xTargetFolder = GDeletedFolder.Folders.Add("Deleted Appointments", olFolderCalendar)
    End If
  Case "ContactItem", "DistListItem"
    Set xTargetFolder = GDeletedFolder.Folders("Deleted Contacts")
    If xTargetFolder Is Nothing Then
      Set xTargetFolder = GDeletedFolder.Folders.Add("Deleted Contacts", olFolderContacts)
    End If
  Case "TaskItem"
    Set xTargetFolder = GDeletedFolder.Folders("Deleted Tasks")
    If xTargetFolder Is Nothing Then
      Set xTargetFolder = GDeletedFolder.Folders.Add("Deleted Tasks", olFolderTasks)
    End If
  Case "JournalItem"
    Set xTargetFolder = GDeletedFolder.Folders("Deleted Journals")
    If xTargetFolder Is Nothing Then
      Set xTargetFolder = GDeletedFolder.Folders.Add("Deleted Journals", olFolderJournal)
    End If
  Case "NoteItem"
    Set xTargetFolder = GDeletedFolder.Folders("Deleted Notess")
    If xTargetFolder Is Nothing Then
      Set xTargetFolder = GDeletedFolder.Folders.Add("Deleted Notess", olFolderNotes)
    End If
End Select
If xTargetFolder Is Nothing Then Exit Sub
Item.Move xTargetFolder
Set xTargetFolder = Nothing
End Sub

3. Speichern Sie diesen Code anschließend und starten Sie Outlook neu, um ihn zu aktivieren.

4. Ab sofort wird jedes gelöschte Element automatisch in den entsprechenden Ordner innerhalb des Gelöschte Elemente-Ordners verschoben.

5. Um das Ergebnis anzuzeigen, klicken Sie bitte auf das Symbol am unteren Rand des Ordnerbereichs und anschließend im Bereich auf Ordner, um „Alle Ordner erweitern“ anzuzeigen (siehe Screenshots):