如何使用olFreeBusyAndSubject或olFullDetails导出含重复会议的Outlook日历？

当使用Outlook VBA的CalendarSharing对象导出日历，设置CalendarDetail为olFreeBusyAndSubject或olFullDetails时，仅能导出重复会议的首个实例，只有olFreeBusyOnly模式下才能导出所有重复实例。以下是实现高细节级别下导出所有重复会议实例的解决方案：

核心思路 #

手动遍历日历中的所有项目，区分单次会议与重复会议：对单次会议直接导出；对重复会议，通过RecurrencePattern.GetOccurrences()方法展开指定时间范围内的所有实例，再统一生成完整的iCalendar格式内容并发送邮件。

修改后的完整代码 #

Sub ExportCalendarWithAllRecurrences()
    Dim olApp As Outlook.Application
    Dim calFolder As Outlook.Folder
    Dim calItems As Outlook.Items
    Dim item As Object
    Dim recurringPattern As Outlook.RecurrencePattern
    Dim recurrenceInstances As Outlook.Items
    Dim instance As Object
    Dim iCalContent As String
    Dim mailItem As Outlook.MailItem
    
    ' 设置导出的时间范围（当月）
    Dim startDate As Date, endDate As Date
    startDate = DateSerial(Year(Date), Month(Date), 1)
    endDate = DateSerial(Year(Date), Month(Date) + 1, 0)
    
    ' 初始化Outlook对象
    Set olApp = Outlook.Application
    Set calFolder = olApp.Session.GetDefaultFolder(olFolderCalendar)
    Set calItems = calFolder.Items
    calItems.IncludeRecurrences = True
    calItems.Sort "[Start]"
    
    ' 初始化iCalendar内容头
    iCalContent = "BEGIN:VCALENDAR" & vbCrLf & _
                  "VERSION:2.0" & vbCrLf & _
                  "PRODID:-//Microsoft Outlook MIMEDIR//EN-US" & vbCrLf
    
    ' 遍历日历项目
    For Each item In calItems
        ' 筛选时间范围内的项目
        If TypeName(item) = "AppointmentItem" Then
            If item.Start >= startDate And item.End <= endDate Then
                ' 处理单次会议
                If Not item.IsRecurring Then
                    iCalContent = iCalContent & item.GetRecurrencePattern().GetOccurrence(item.Start).ICal & vbCrLf
                Else
                    ' 处理重复会议，展开所有实例
                    Set recurringPattern = item.GetRecurrencePattern()
                    Set recurrenceInstances = recurringPattern.GetOccurrences(startDate, endDate)
                    For Each instance In recurrenceInstances
                        iCalContent = iCalContent & instance.ICal & vbCrLf
                    Next instance
                End If
            End If
        End If
    Next item
    
    ' 添加iCalendar内容尾
    iCalContent = iCalContent & "END:VCALENDAR" & vbCrLf
    
    ' 创建邮件并添加iCalendar附件
    Set mailItem = olApp.CreateItem(olMailItem)
    With mailItem
        .To = "my_mail@live.de"
        .Subject = Date & " " & Time & " 完整日历导出"
        .Body = "Kalenderexport"
        ' 将iCalendar内容保存为临时文件并作为附件添加
        Dim tempFilePath As String
        tempFilePath = Environ("TEMP") & "\CalendarExport_" & Format(Now, "YYYYMMDDHHMMSS") & ".ics"
        Open tempFilePath For Output As #1
        Print #1, iCalContent
        Close #1
        .Attachments.Add tempFilePath, olByValue, 1, "Calendar.ics"
        .Send
        ' 删除临时文件
        Kill tempFilePath
    End With
    
    ' 释放对象
    Set mailItem = Nothing
    Set instance = Nothing
    Set recurrenceInstances = Nothing
    Set recurringPattern = Nothing
    Set item = Nothing
    Set calItems = Nothing
    Set calFolder = Nothing
    Set olApp = Nothing
    
    MsgBox "日历导出已完成并发送！", vbInformation
End Sub

代码关键说明 #

• calItems.IncludeRecurrences = True：确保遍历逻辑包含重复会议的实例
• GetOccurrences(startDate, endDate)：精准获取重复会议在指定时间范围内的所有实例
• item.ICal：直接提取单个会议实例的标准iCalendar格式内容，保证导出细节与原会议一致
• 临时文件处理：将拼接好的iCalendar内容保存为.ics文件，作为邮件附件发送，兼容主流日历导入工具

内容的提问来源于stack exchange，提问作者Hyu22