Hoe verschillende soorten verwijderde items automatisch naar verschillende mappen in Outlook te verplaatsen?

In Outlook worden alle soorten verwijderde items (mails, taken, contacten, enz.) verplaatst naar de map Verwijderde items. Als u de items naar verschillende mappen wilt verplaatsen op basis van het itemtype onder de map Verwijderde items, zoals hieronder afgebeeld, hoe kunt u dit dan in Outlook maken?

Verplaats verschillende soorten verwijderde items automatisch naar verschillende mappen met VBA-code

De onderstaande VBA-code kan u helpen om de verwijderde items automatisch naar verschillende mappen te verplaatsen, doe dit als volgt:

1. Start Outlook en houd vervolgens ingedrukt ALT + F11 toetsen om de te openen Microsoft Visual Basic voor toepassingen venster.

2. Dubbelklik vervolgens DezeOutlookSessie van het Project-Project1 deelvenster en kopieer en plak vervolgens de onderstaande code in het lege codevenster:

VBA-code: verplaats verschillende soorten verwijderde items automatisch naar verschillende mappen

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. Sla deze code vervolgens op en start Outlook opnieuw om deze code te activeren.

4. Wanneer u vanaf nu een item verwijdert, wordt het verplaatst naar het overeenkomstige type map onder Verwijderde items map automatisch.

5. Om het resultaat te zien, klik a.u.b. pictogram onder aan het mappenvenster en klik vervolgens op Mappen om alle mappen in het paneel uit te vouwen, zie screenshots: