Как да премествам различни видове изтрити елементи в различни папки автоматично в Outlook?

Автор: Xiaoyang Последна промяна: 2022-10-19

В Outlook всички видове изтрити елементи (писма, задачи, контакти и т.н.) ще бъдат преместени в папката Изтрити елементи. Ако искате да преместите елементите в различни папки въз основа на типа на елемента в папката „Изтрити елементи“, както е показано на екранната снимка по-долу, как можете да го направите в Outlook?

Премествайте различни видове изтрити елементи в различни папки автоматично с VBA код

Кодът VBA по-долу може да ви помогне да преместите автоматично изтритите елементи в различни папки, моля, направете следното:

1. Стартирайте Outlook и след това задръжте ALT + F11 за да отворите Microsoft Visual Basic за приложения прозорец.

2. След това щракнете два пъти ThisOutlookSession от Проект-Проект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. За да видите резултата, моля щракнете иконата в долната част на панела с папки и след това щракнете Папки за да разгънете всички папки в панела, вижте екранни снимки: