Comment déplacer automatiquement les différents types d’éléments supprimés vers des dossiers distincts dans Outlook ?

Dans Outlook, tous les éléments supprimés (e-mails, tâches, contacts, etc.) sont déplacés vers le dossier Éléments supprimés. Si vous souhaitez organiser ces éléments dans des sous-dossiers distincts selon leur type, comme le montre la capture d’écran ci-dessous, comment procéder dans Outlook ?

---

Déplacer automatiquement différents types de Éléments supprimés dans des dossiers distincts à l’aide d’un code VBA

Le code VBA ci-dessous vous permet de déplacer automatiquement les éléments supprimés vers des dossiers distincts. Voici la marche à suivre :

1. Lancez Outlook, puis maintenez enfoncées les touches ALT + F11 pour ouvrir la fenêtre Microsoft Visual Basic pour Applications.

2. Ensuite, double-cliquez sur ThisOutlookSession dans le volet Projet - Projet1, puis copiez-collez le code ci-dessous dans la fenêtre de code vierge :

Code VBA : déplacer automatiquement différents types de Éléments supprimés dans des dossiers distincts

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. Ensuite, enregistrez ce code et redémarrez Outlook pour l’activer.

4. Désormais, lorsque vous supprimez un élément, il est automatiquement déplacé vers le dossier correspondant à son type, situé sous le dossier Éléments supprimés.

5. Pour visualiser le résultat, cliquez sur l’icône située en bas du volet des dossiers, puis sur Dossiers pour développer tous les dossiers dans le volet. Voir les captures d’écran :