如何在Outlook中自動將不同類型的已刪除項目移動到不同的資料夾？

Author: Xiaoyang Last Modified: 2025-05-12

在Outlook中，所有類型的已刪除項目（郵件、任務、聯絡人等）都會被移動到「已刪除郵件」資料夾。如果您想根據項目類型將這些項目移動到「已刪除郵件」資料夾下的不同資料夾，如下方截圖所示，該如何在Outlook中實現呢？

doc-move-different-deleted-items-1

使用VBA代碼自動將不同類型的已刪除項目移動到不同的資料夾

以下VBA代碼可以幫助您自動將已刪除項目移動到不同的資料夾，請按照以下步驟操作：

1. 啟動Outlook，然後按住 ALT + F11 鍵以打開 Microsoft Visual Basic for Applications 窗口。

2. 接著，在「專案-專案1」窗格中雙擊 ThisOutlookSession，然後複製並將以下代碼粘貼到空白代碼窗口中：

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

doc-move-different-deleted-items-2