如何在 Outlook 中自动将不同类型的已删除邮件分别移动到不同的文件夹？

在 Outlook 中，各类已删除项目（如邮件、任务、联系人等）都会被移动到“已删除邮件”文件夹。如果您希望根据项目类型，将这些项目分别移动到“已删除邮件”文件夹下的不同子文件夹，如下图所示，该如何操作？

---

利用 VBA 代码自动将不同类型的已删除邮件移动到不同的文件夹

下面的 VBA 代码可以帮助您自动将已删除邮件移动到不同的文件夹，请按照以下步骤操作：

11. 启动 Outlook，按住 ALT + F11 键即可打开 Microsoft Visual Basic for Applications 窗口。

22. 然后，双击 ThisOutlookSession，在 Project-Project 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

33. 保存代码后，重启 Outlook 即可激活该代码。

4 从现在起，每当您删除项目时，系统会自动将其移动到已删除邮件文件夹下对应类型的子文件夹。

5 要查看效果，请点击底部的文件夹窗格图标，然后单击文件夹，即可在窗格中展开所有文件夹，具体见截图：