Outlook FreeBusy方法异常：Working Elsewhere状态返回值为5而非文档标注的4

我通过Outlook VBA脚本调用FreeBusy方法查询多人日历状态，多数OlBusyStatus状态返回值与官方文档一致，但当约会设置为Working Elsewhere时，返回值为5，而非文档标注的4，且找不到关于值5的官方说明。现需找到可靠方法，判断同一时间段内两个不同日历约会是否存在冲突。

测试代码示例：

startDate = #1/15/2024#
' Assign a new AppointmentItem object to the objMeeting variable
Set objMeeting = Application.CreateItem(olAppointmentItem)
' Set the properties of the meeting
With objMeeting
    ' Assign the subject of the meeting
    .Subject = "Test meeting"
    ' Assign the location of the meeting
    .Location = "Room 1"
    ' Assign the date and time of the start of the meeting
    .Start = #1/15/2024#
    ' Assign the date and time of the end of the meeting
'    .End = #1/25/2024#
    ' Assign the body of the meeting message
    .Body = "This is a test meeting created by a macro."
    ' Assign the status of the meeting as requested
    .MeetingStatus = olMeeting
End With

' Assign the Recipients object to the objRecipients variable
Set objRecipients = objMeeting.Recipients

    objRecipients.Add (myemail)

For Each objRecipient In objRecipients
   'Get the availability for each recipients
   myVal = objRecipient.FreeBusy(startDate, 30, True)
Next

1. 兼容FreeBusy返回的异常值5 #

测试已确认5对应Working Elsewhere状态，可在代码中直接将其映射为文档标注的4，统一处理忙碌状态：

For Each objRecipient In objRecipients
   myVal = objRecipient.FreeBusy(startDate, 30, True)
   Dim slotStatus As Integer
   For i = 1 To Len(myVal)
       slotStatus = CInt(Mid(myVal, i, 1))
       ' 将异常值5映射为官方定义的olWorkingElsewhere(4)
       If slotStatus = 5 Then slotStatus = 4
       
       ' 根据状态判断忙碌情况
       Select Case slotStatus
           Case 0: ' 空闲
           Case 1: ' 暂定忙碌
           Case 2: ' 忙碌
           Case 3: ' 外出
           Case 4: ' 异地办公/Working Elsewhere
       End Select
   Next i
Next

2. 更可靠的日历冲突判断方法 #

若依赖FreeBusy枚举值易出现偏差，可直接获取目标用户的日历项，通过时间对比判断冲突：

核心函数：检查目标用户日历是否存在时间重叠 #

Function HasCalendarConflict(targetEmail As String, checkStart As Date, checkEnd As Date) As Boolean
    Dim ns As NameSpace
    Dim sharedCalendar As Folder
    Dim appt As AppointmentItem
    Dim conflictFound As Boolean
    
    Set ns = Application.GetNamespace("MAPI")
    ' 获取目标用户的共享日历（需有访问权限）
    Set sharedCalendar = ns.GetSharedDefaultFolder(ns.CreateRecipient(targetEmail), olFolderCalendar)
    
    conflictFound = False
    ' 遍历日历中与检查时间段有交集的约会
    For Each appt In sharedCalendar.Items
        ' 统一日期格式避免异常
        appt.Start = CDate(appt.Start)
        appt.End = CDate(appt.End)
        
        ' 判断时间重叠：约会开始在检查时段内、结束在时段内，或完全包含检查时段
        If (appt.Start < checkEnd And appt.End > checkStart) Then
            ' 排除已取消的约会
            If appt.MeetingStatus <> olMeetingCanceled Then
                conflictFound = True
                Exit For
            End If
        End If
    Next appt
    
    HasCalendarConflict = conflictFound
    ' 释放对象
    Set ns = Nothing
    Set sharedCalendar = Nothing
    Set appt = Nothing
End Function

使用示例 #

Dim meetingStart As Date, meetingEnd As Date
meetingStart = #1/15/2024 9:00:00 AM#
meetingEnd = #1/15/2024 10:00:00 AM#

If HasCalendarConflict("target@example.com", meetingStart, meetingEnd) Then
    MsgBox "存在日历冲突"
Else
    MsgBox "无冲突"
End If

说明 #

• 直接遍历日历项的方法虽比FreeBusy稍慢，但结果更准确，不受枚举值异常影响。
• 需确保当前账号有访问目标用户日历的权限，否则GetSharedDefaultFolder会触发权限错误。

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