Kako v Outlooku samodejno premakniti različne vrste izbrisanih elementov v različne mape?

V Outlooku bodo vse vrste izbrisanih predmetov (e-pošta, opravila, stiki itd.) premaknjene v mapo Izbrisani predmeti. Če želite premakniti elemente v različne mape glede na vrsto elementa v mapi Izbrisani predmeti, kot je prikazano na spodnjem posnetku zaslona, kako lahko to naredite v Outlooku?

Samodejno premaknite različne vrste izbrisanih elementov v različne mape s kodo VBA

Spodnja koda VBA vam lahko pomaga pri samodejnem premikanju izbrisanih elementov v druge mape, naredite naslednje:

1. Zaženite Outlook in pridržite ALT + F11 tipke za odpiranje Microsoft Visual Basic za aplikacije okno.

2. Nato dvokliknite Ta OutlookSession Iz Projekt-projekt1 podoknu, nato pa kopirajte in prilepite spodnjo kodo v prazno okno kode:

Koda VBA: samodejno premaknite različne vrste izbrisanih elementov v različne mape

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. Nato shranite to kodo in znova zaženite Outlook, da aktivirate to kodo.

4. Odslej, ko izbrišete element, bo premaknjen v ustrezno vrsto mape pod Izbrisani predmeti mapo samodejno.

5. Za ogled rezultata kliknite ikono na dnu podokna z mapo in nato kliknite mape če želite razširiti vse mape v podoknu, si oglejte posnetke zaslona: