Outlook で削除済みアイテムの種類に応じて、自動的にそれぞれ専用のフォルダーに移動させるにはどうすればよいですか？

Outlook では、メール、タスク、連絡先などあらゆる種類の削除済みアイテムが「削除済みアイテム」フォルダーに一括で移動されます。以下のスクリーンショットのように、「削除済みアイテム」フォルダー内にアイテムの種類ごとに別々のフォルダーを作成し、自動的に振り分けたい場合は、Outlook でどのように設定すればよいでしょうか？

---

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

次の手順に従って、以下の VBA コードを使えば、削除済みアイテムを自動的に別のフォルダーに移動できます。

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

2。次に、ThisOutlookSessionをProject-Project1ペインでダブルクリックし、表示される空のコードウィンドウに以下のコードをコピー＆ペーストしてください。

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。結果を確認するには、フォルダーペインの下部にあるアイコンをクリックし、続いてペイン内のフォルダーをクリックして、すべてのフォルダーを展開してください。スクリーンショットをご覧ください。