¿Cómo mover diferentes tipos de elementos eliminados a diferentes carpetas automáticamente en Outlook?

En Outlook, todo tipo de elementos eliminados (correos, tareas, contactos, etc.) se moverán a la carpeta Elementos eliminados. Si desea mover los elementos a diferentes carpetas según el tipo de elemento en la carpeta Elementos eliminados como se muestra a continuación, ¿cómo puede hacerlo en Outlook?

Mueva diferentes tipos de elementos eliminados a diferentes carpetas automáticamente con código VBA

El siguiente código de VBA puede ayudarlo a mover los elementos eliminados a diferentes carpetas automáticamente, haga lo siguiente:

1. Inicie Outlook y, a continuación, mantenga pulsado ALT + F11 teclas para abrir el Microsoft Visual Basic para aplicaciones ventana.

2. Luego, haga doble clic Esta sesión de Outlook del desplegable Proyecto-Proyecto1 y luego copie y pegue el siguiente código en la ventana de código en blanco:

Código VBA: mueva diferentes tipos de elementos eliminados a diferentes carpetas automáticamente

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. Luego, guarde este código y reinicie Outlook para activar este código.

4. A partir de ahora, cuando elimine un elemento, se moverá al tipo de carpeta correspondiente en Objetos eliminados carpeta automáticamente.

5. Para ver el resultado, haga clic en en la parte inferior del panel de carpetas y, a continuación, haga clic en Carpetas para expandir todas las carpetas en el panel, vea las capturas de pantalla: