كيف تُرسل تقويمًا إلى عدة مستلمين بشكل فردي في Outlook؟

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

إرسال تقويم إلى عدة مستلمين بشكل فردي باستخدام كود VBA

---

إرسال تقويم إلى عدة مستلمين بشكل فردي باستخدام كود VBA

لإرسال تقويم إلى عدة مستلمين بشكل منفصل، يمكن أن يساعدك كود VBA التالي. يُرجى اتباع الخطوات التالية:

1. انتقل إلى قسمجهات الاتصال، وحدد جهات الاتصال التي تريد إرسال التقويم إليها.

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

3. انقر علىإدراج > وحدة نمطية (Module)، ثم انسخ الكود أدناه والصقه في وحدة نمطية فارغة مفتوحة، كما هو موضح في لقطة الشاشة:

كود VBA: إرسال تقويم إلى عدة مستلمين بشكل فردي:

Sub EmailCalendarToMultiplePersonsSeparately()
Dim xSelection As Outlook.Selection
Dim xCalendarFolder As Outlook.Folder
Dim xCalendarExporter As Outlook.CalendarSharing
Dim xStartDate, xEndDate As Date
Dim xCalendarFile As String
Dim xContactItem As Outlook.ContactItem
Dim xDistListItem As Outlook.DistListItem
Dim xItem As Object
Dim xMailItem As Outlook.MailItem
Dim xFilePath, xFileName, xEmailAddress As String
Dim xRecipient As Recipient
On Error Resume Next
xFilePath = CreateObject("WScript.Shell").SpecialFolders(16) & "\MyCalendar"
If Dir(xFilePath, vbDirectory) = "" Then MkDir xFilePath
If Outlook.Application.ActiveExplorer.CurrentFolder.DefaultItemType <> olContactItem Then
    MsgBox "Please Select contacts first!", vbExclamation + vbOKOnly, "Kutools for Outlook"
    Exit Sub
End If
Set xSelection = Outlook.Application.ActiveExplorer.Selection
If xSelection Is Nothing Then Exit Sub
Set xCalendarFolder = Outlook.Application.Session.PickFolder
If xCalendarFolder Is Nothing Then Exit Sub
If xCalendarFolder.DefaultItemType <> olAppointmentItem Then Exit Sub
Set xCalendarExporter = xCalendarFolder.GetCalendarExporter
xStartDate = InputBox("Enter the start date:", "Kutools for Outlook", "")
If Len(Trim(xStartDate)) = 0 Then Exit Sub
xEndDate = InputBox("Enter the end date:", "Kutools for Outlook", "")
If Len(Trim(xEndDate)) = 0 Then Exit Sub
If xStartDate = #1/1/4501# Or xEndDate = #1/1/4501# Then Exit Sub
xFileName = "Calendar (" & Format(xStartDate, "YYYYMMDD") & " - " & Format(xEndDate, "YYYYMMDD") & ").ics"
xCalendarFile = xFilePath & "\" & xFileName
With xCalendarExporter
    .IncludeWholeCalendar = False
    .StartDate = xStartDate
    .EndDate = xEndDate
    .CalendarDetail = olFullDetails
    .IncludeAttachments = True
    .IncludePrivateDetails = False
    .RestrictToWorkingHours = False
    .SaveAsICal xCalendarFile
End With
For Each xItem In xSelection
    If xItem.Class = olContact Then
        Set xContactItem = xItem
        Set xMailItem = Outlook.Application.CreateItem(olMailItem)
        With xMailItem
            .To = xContactItem.Email1Address
            .Recipients.ResolveAll
            .Subject = xFileName
            .Attachments.Add xCalendarFile
            .Body = "Dear " & xContactItem.FullName & "," & vbCrLf & "Type body here..."
            .Display
        End With
    End If
    If xItem.Class = olDistributionList Then
        Set xDistListItem = xItem
        For i = 1 To xDistListItem.MemberCount
            Set xRecipient = xDistListItem.GetMember(i)
            Set xMailItem = Outlook.Application.CreateItem(olMailItem)
            With xMailItem
                .To = xRecipient.AddressEntry.Address
                .Recipients.ResolveAll
                .Subject = xFileName
                .Attachments.Add xCalendarFile
                .Body = "Dear " & xRecipient.Name & "," & vbCrLf & "Type body here..."
                .Display
            End With
        Next i
    End If
Next
End Sub

4. بعد إدخال الكود، اضغط على مفتاحF5 لتشغيله، وستظهر نافذة مربع حوارتحديد مجلد. يُرجى تحديد التقويم الذي تريد إرساله، كما هو موضح في لقطة الشاشة:

5.انقر علىموافق، ثم حدّد نطاق التاريخ التي تريد إرسال التقويم منها في مربعات الإرشاد التالية، كما هو موضح في لقطة الشاشة:

6. بعد ذلك، انقر علىموافق. سيتم إنشاء بريد إلكتروني جديد مع التقويم المرفق كما هو موضح في لقطة الشاشة التالية، وبعدها لن يبقى لك سوى إرسالها واحدًا تلو الآخر.

---

مقالات ذات صلة:

كيف تُرسل بريدًا إلكترونيًّا إلى عدة مستلمين بشكل فردي في Outlook؟

كيف تُرسل رسائل بريد إلكتروني جماعية مخصصة إلى قائمة جهات اتصال من Excel عبر Outlook؟

كيف تُرسل مسودات متعددة دفعة واحدة في Outlook؟

كيف تُرسل بريدًا إلكترونيًّا إلى عدة مستلمين دون أن يعلم بعضهم بوجود الآخرين في Outlook؟