Hur flyttar man olika typer av raderade objekt till olika mappar automatiskt i Outlook?

I Outlook kommer alla typer av raderade objekt (e-post, uppgifter, kontakter, etc.) att flyttas till mappen Borttagna objekt. Om du vill flytta objekten till olika mappar baserat på objekttypen under mappen Borttagna objekt enligt skärmbilden nedan, hur kan du göra det i Outlook?

Flytta olika typer av raderade objekt till olika mappar automatiskt med VBA-kod

VBA-koden nedan kan hjälpa dig att automatiskt flytta de raderade objekten till olika mappar, vänligen gör så här:

1. Starta Outlook och håll sedan ned ALT + F11 nycklar för att öppna Microsoft Visual Basic för applikationer fönster.

2. Dubbelklicka sedan ThisOutlookSession från Projekt-projekt1 rutan, och kopiera och klistra sedan in nedanstående kod i det tomma kodfönstret:

VBA-kod: Flytta olika typer av raderade objekt till olika mappar automatiskt

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. Spara sedan den här koden och starta om Outlook för att aktivera den här koden.

4. Från och med nu, när du tar bort ett objekt, kommer det att flyttas till motsvarande typ av mapp under Raderade föremål mappen automatiskt.

5. Klicka på för att se resultatet ikonen längst ned i mapprutan och klicka sedan på mappar för att expandera alla mappar i rutan, se skärmdumpar: