Hoe verplaatst u automatisch verschillende soorten verwijderde items naar afzonderlijke mappen in Outlook?

In Outlook worden alle soorten verwijderde items (e-mails, taken, contactpersonen, enz.) standaard verplaatst naar de map Verwijderde Items. Als u deze items op basis van hun type automatisch naar verschillende submappen binnen de map Verwijderde Items wilt sorteren — zoals weergegeven in de onderstaande schermafbeelding — hoe doet u dat dan in Outlook?

---

Verplaats automatisch verschillende typen Verwijderde Items naar verschillende mappen met VBA-code

De onderstaande VBA-code helpt u automatisch verwijderde items naar verschillende mappen te verplaatsen. Volg deze stappen:

1. Start Outlook en houd daarna de toetsen ALT + F11 ingedrukt om het venster Microsoft Visual Basic for Applications te openen.

2. Dubbelklik vervolgens op ThisOutlookSession in het deelvenster Project-Project1 en kopieer en plak de onderstaande code in het lege codevenster:

VBA-code: Verplaats automatisch verschillende typen Verwijderde Items naar verschillende mappen

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. Sla deze code op en start Outlook opnieuw om de code te activeren.

4. Vanaf nu wordt elk item dat u verwijdert automatisch verplaatst naar de bijbehorende map voor dat itemtype in de map Verwijderde Items.

5. Klik op het pictogram onderaan het mapdeelvenster om het resultaat te bekijken, en klik daarna op Mappen om alle mappen uitgevouwen in het deelvenster te zien; zie de schermafbeeldingen: