كيف يمكن نقل الاجتماعات المرسلة تلقائيًا إلى مجلد معيّن في Outlook؟

عادةً، بعد إرسال رسائل البريد الإلكتروني أو دعوات الاجتماعات، يتم وضع كليهما في مجلد الرسائل المرسلة. لذا، سيصبح مجلد الرسائل المرسلة فوضويًا ومرهقًا إلى حدٍ كبير. في هذه المقالة، سأقدّم طريقة لنقل الاجتماعات المرسلة تلقائيًا إلى مجلد آخر بعد إرسال الدعوة.

نقل الاجتماعات المرسلة تلقائيًا إلى مجلد معيّن باستخدام كود VBA

---

نقل الاجتماعات المرسلة تلقائيًا إلى مجلد معيّن باستخدام كود VBA

لنقل جميع دعوات الاجتماعات المرسلة تلقائيًا إلى مجلد آخر، يُمكنك استخدام الكود التالي. يُرجى اتباع الخطوات التالية:

1. اضغط مع الاستمرار على مفتاحَيALT + F11 لفتح نافذةMicrosoft Visual Basic for Applications.

2. في نافذةMicrosoft Visual Basic for Applications، انقر مرتين علىThisOutlookSession من جزءProject1 (VbaProject.OTM) لفتح الوحدة النمطية، ثم انسخ والصق الكود التالي في الوحدة النمطية الفارغة.

كود VBA: نقل الاجتماعات المرسلة تلقائيًا إلى مجلد معيّن

Private WithEvents GExplorer As Outlook.Explorer
Public WithEvents GSentFolder As Outlook.Folder
Public WithEvents GSentItems As Outlook.Items
Private Sub Application_Startup()
    Set GExplorer = Outlook.Application.ActiveExplorer
End Sub
Private Sub GExplorer_SelectionChange()
Dim xFolder As Folder, xRootFolder As Folder
Dim xRootFldName As String
Dim xPos As Integer
    On Error Resume Next
    Set xFolder = Outlook.Application.ActiveExplorer.CurrentFolder
    xPos = VBA.InStr(3, xFolder.FolderPath, "\")
    If xPos > 0 Then
        xRootFldName = VBA.Mid(xFolder.FolderPath, 3, xPos - 3)
    Else
        xRootFldName = VBA.Mid(xFolder.FolderPath, 3, Len(xFolder.FolderPath) - 2)
    End If
    Set xRootFolder = Outlook.Application.Session.Folders(xRootFldName)
    Set GSentFolder = xRootFolder.Folders("Sent Items")
    Set GSentItems = GSentFolder.Items
End Sub
Private Sub GSentItems_ItemAdd(ByVal Item As Object)
    Dim xMeetingItem As Outlook.MeetingItem
    Dim xTargetFolder As Outlook.Folder
    On Error Resume Next
    If Item.Class <> olMeetingRequest Then Exit Sub
    Set xMeetingItem = Item
    Set xTargetFolder = GSentFolder.Folders("Meetings")
    If xTargetFolder Is Nothing Then
        Set xTargetFolder = GSentFolder.Folders.Add("Meetings")
    End If
    xMeetingItem.Move xTargetFolder
End Sub

3. بعد ذلك، احفظ وأغلق نافذة الكود. الآن، عند إرسال رسالة اجتماع، سيتم نقلها تلقائيًا إلى مجلد جديد باسمMeetings ضمن مجلدالرسائل المرسلة. راجع لقطة الشاشة: