如何在 Outlook 中将日历单独发送给多个收件人？

通常，您可以通过使用通过电子邮件发送日历功能，在 Outlook 中快速便捷地将日历发送给单个收件人。如果您想以 iCalendar 文件形式分别发送日历给多个联系人，则需要逐一操作。本文将为您介绍一种在 Outlook 中单独发送日历给多个收件人的高效方法，轻松提升工作效率。

使用 VBA 代码将日历分别发送给多个收件人

---

使用 VBA 代码将日历分别发送给多个收件人

若要分别向多个收件人发送日历，可以借助以下 VBA 代码，请按如下操作：

1. 在联系人窗格中，勾选您想要发送日历的联系人。

2. 按住 ALT + F11 键，即可打开 Microsoft Visual Basic for Applications 窗口。

3. 点击插入 > 模块，将下方代码复制并粘贴到新建的空白模块中，如下图所示：

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 中将邮件分别发送给多个收件人？

如何通过 Outlook 将个性化群发邮件从 Excel 名单中发送出去？

如何在 Outlook 中批量发送多封草稿？

如何在 Outlook 中群发邮件时让收件人彼此不可见？