Jak automaticky přesunout různé typy smazaných položek do různých složek v aplikaci Outlook?

V aplikaci Outlook se všechny druhy odstraněných položek (e-maily, úkoly, kontakty atd.) přesunou do složky Odstraněná pošta. Pokud chcete přesunout položky do různých složek na základě typu položky ve složce Odstraněné položky, jak je znázorněno na obrázku níže, jak to můžete provést v aplikaci Outlook?

Přesunout různé typy odstraněných položek do různých složek automaticky pomocí kódu VBA

Níže uvedený kód VBA vám může pomoci automaticky přesunout odstraněné položky do různých složek, postupujte takto:

1. Spusťte aplikaci Outlook a poté podržte ALT + F11 klávesy pro otevření Microsoft Visual Basic pro aplikace okno.

2. Poté poklepejte ThisOutlookSession z Projekt-Projekt1 podokno a poté zkopírujte a vložte níže uvedený kód do prázdného okna kódu:

Kód VBA: Automaticky přesouvejte různé typy smazaných položek do různých složek

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. Potom tento kód uložte a restartujte aplikaci Outlook, abyste tento kód aktivovali.

4. Od této chvíle, když smažete položku, bude přesunuta do odpovídajícího typu složky pod Smazané položky složku automaticky.

5. Chcete-li zobrazit výsledek, klikněte ikonu v dolní části podokna složek a potom klepněte na Složky Chcete-li rozbalit všechny složky v podokně, podívejte se na snímky obrazovky: