كيف يمكن نقل أنواع مختلفة من العناصر المحذوفة تلقائيًا إلى مجلدات مخصصة في Outlook؟

في Outlook، يتم نقل جميع أنواع العناصر المحذوفة (مثل الرسائل والمهام وجهات الاتصال وما إلى ذلك) تلقائيًا إلى مجلد «العناصر المحذوفة». إذا كنت ترغب في فرز هذه العناصر ونقلها تلقائيًا إلى مجلدات فرعية مختلفة داخل مجلد «العناصر المحذوفة» حسب نوع كل عنصر—كما هو موضح في لقطة الشاشة أدناه—فكيف يمكنك تحقيق ذلك في Outlook؟

---

نقل أنواع مختلفة من عناصر المحذوفة إلى مجلدات مختلفة تلقائيًا باستخدام كود VBA

يمكن أن يساعدك كود VBA أدناه على نقل عناصر المحذوفة إلى مجلدات مختلفة تلقائيًا، يُرجى اتباع الخطوات التالية:

1. افتح Outlook، ثم اضغط مع الاستمرار على مفاتيحALT + F11 لفتح نافذة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. لعرض النتيجة، انقر على أيقونة الموجودة في أسفل جزء المجلدات، ثم انقر علىالمجلداتلتوسيع جميع المجلدات في الجزء. راجع لقطات الشاشة: