Outlookで異なる種類の削除されたアイテムを自動的に別のフォルダーに移動するにはどうすればよいですか？

Author: Xiaoyang Last Modified: 2025-05-23

Outlookでは、すべての種類の削除されたアイテム（メール、タスク、連絡先など）が「削除済みアイテム」フォルダーに移動されます。以下のようなスクリーンショットのように、アイテムの種類に基づいて「削除済みアイテム」フォルダー内の異なるフォルダーにアイテムを移動したい場合、Outlookでどのように設定すればよいでしょうか？

doc-move-different-deleted-items-1

VBAコードを使用して、異なる種類の削除されたアイテムを自動的に別のフォルダーに移動する

以下のVBAコードは、削除されたアイテムを自動的に異なるフォルダーに移動するのに役立ちます。次の手順で行ってください：

1. Outlookを起動し、ALT + F11キーを押したままにして、Microsoft Visual Basic for Applicationsウィンドウを開きます。

2. 次に、プロジェクト-Project1ペインから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