求助：Outlook日历VBA无法读取指定日期范围内的定期会议

我帮你找到了代码里导致无法读取定期会议的几个关键问题，下面咱们一步步拆解并修正：

核心问题点 #

• IncludeRecurrences 属性设置顺序错误：你当前先对日历项排序，再启用重复项展开，这不符合Outlook对象模型的要求——必须先设置IncludeRecurrences = True，再执行排序操作，否则重复约会不会被展开为单独的实例。
• 未使用范围筛选导致效率低下且遗漏：直接遍历所有日历项不仅慢，而且即使启用了重复项展开，也可能因为遍历逻辑的问题漏过部分实例，正确的做法是用Restrict方法先筛选出指定日期范围内的项目。
• 日期边界判断不严谨：原代码中ToDate默认是当天00:00:00，会漏掉当天下午/晚上的会议，需要将其调整为当天的23:59:59，或者结合约会的结束时间做判断。
• 遗漏Location列赋值：原代码表头定义了Location列，但循环里没有给对应单元格赋值，这里也一起补上。

修正后的完整代码 #

Sub GetOutlookCalendarAppointments()
    Dim olApp As Outlook.Application
    Dim olNS As Outlook.Namespace
    Dim olFolder As Outlook.Folder
    Dim olItems As Outlook.Items
    Dim olApt As Outlook.AppointmentItem
    Dim FromDate As Date, ToDate As Date
    Dim NextRow As Long
    Dim strFilter As String
    
    ' 设置日期范围，将ToDate调整为当天的最后一秒，避免漏掉当日晚些时候的会议
    FromDate = CDate("10/06/2019")
    ToDate = CDate("10/12/2019") + TimeSerial(23, 59, 59)
    
    ' 初始化Outlook应用实例
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If Err.Number > 0 Then
        Set olApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    
    Set olNS = olApp.GetNamespace("MAPI")
    Set olFolder = olNS.GetDefaultFolder(olFolderCalendar) ' 使用常量更易读
    
    ' 关键：先启用重复项展开，再执行排序操作
    Set olItems = olFolder.Items
    olItems.IncludeRecurrences = True
    olItems.Sort "[Start]"
    
    ' 构建筛选条件，精准获取指定日期范围内的约会
    strFilter = "[Start] >= '" & Format(FromDate, "yyyy-mm-dd hh:mm:ss") & "' AND [End] <= '" & Format(ToDate, "yyyy-mm-dd hh:mm:ss") & "'"
    Set olItems = olItems.Restrict(strFilter)
    
    NextRow = 2
    With Sheets("Sheet1")
        .Range("A1:F1").Value = Array("Report Date", "Date", "Time spent", "Location", "Categories", "Title")
        ' 遍历筛选后的日历项
        For Each olApt In olItems
            .Cells(NextRow, "A").Value = Format(Now, "DD-MM-YY")
            .Cells(NextRow, "B").Value = CDate(olApt.Start)
            .Cells(NextRow, "C").Value = olApt.End - olApt.Start
            .Cells(NextRow, "C").NumberFormat = "HH:MM"
            .Cells(NextRow, "D").Value = olApt.Location ' 补全Location列赋值
            .Cells(NextRow, "E").Value = olApt.Categories
            .Cells(NextRow, "F").Value = olApt.Subject
            NextRow = NextRow + 1
        Next olApt
        .Columns.AutoFit
    End With
    
    ' 释放对象，避免内存占用
    Set olApt = Nothing
    Set olItems = Nothing
    Set olFolder = Nothing
    Set olNS = Nothing
    Set olApp = Nothing
End Sub

关键修正说明 #

1. 调整IncludeRecurrences与Sort的顺序：先启用重复项展开，再对项目按开始时间排序，确保Outlook将定期会议展开为指定日期范围内的单独实例。
2. 使用Restrict方法筛选：通过筛选条件直接获取目标日期范围内的项目，大幅提升效率，同时确保所有符合条件的重复项实例都被包含。
3. 修正日期边界：将ToDate加上当天的最后一秒，避免漏掉当天的后续会议；同时筛选条件结合了[End]，确保不会截断跨天的会议。
4. 补全Location列赋值：原代码表头定义了Location列但未赋值，现在已经补上对应逻辑。

内容的提问来源于stack exchange，提问作者Miss.Tech