Как автоматически перемещать удаленные элементы разных типов в разные папки в Outlook?

В Outlook все виды удаленных элементов (письма, задачи, контакты и т. д.) будут перемещены в папку «Удаленные». Если вы хотите переместить элементы в разные папки в зависимости от типа элемента в папке «Удаленные», как показано на снимке экрана ниже, как вы можете сделать это в Outlook?

Автоматически перемещайте различные типы удаленных элементов в разные папки с помощью кода VBA.

Приведенный ниже код VBA может помочь вам автоматически перемещать удаленные элементы в разные папки, сделайте следующее:

1. Запустите Outlook, а затем, удерживая ALT + F11 , чтобы открыть Microsoft Visual Basic для приложений окно.

2. Затем дважды щелкните Эта сессия Outlook из Проект-Проект1 панели, а затем скопируйте и вставьте приведенный ниже код в пустое окно кода:

Код VBA: автоматически перемещать различные типы удаленных элементов в разные папки.

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. Затем сохраните этот код и перезапустите Outlook, чтобы активировать этот код.

4. Отныне, когда вы удаляете элемент, он будет перемещаться в папку соответствующего типа в Удаленные предметы папку автоматически.

5. Для просмотра результата нажмите значок в нижней части панели папок, а затем щелкните Папки чтобы развернуть все папки на панели, см. скриншоты: