如何使用VBA获取Outlook会话中自动回复(OutOfOffice)的日期？

完全可以通过Outlook VBA原生对象模型实现需求，不需要第三方依赖，核心实现逻辑如下：

• 调用Store.GetAutoReplySettings方法读取目标邮箱的自动回复配置，直接获取外出模式的启用状态、生效起止时间
• 状态判断逻辑：如果自动回复当前已生效，提取结束日期作为提示；如果是预设置了未来生效的外出规则，提取最近一次的开始日期作为提示
• 读取Outlook签名对应的本地HTML/RTF/文本文件，将外出日期插入到签名的指定位置，也可以直接动态生成新的签名内容覆盖原有文件

参考代码片段 #

Sub UpdateSignatureWithOOODate()
    Dim oNamespace As Outlook.NameSpace
    Dim oStore As Outlook.Store
    Dim oAutoReply As Outlook.AutoReplySettings
    Dim oFSO As Object
    Dim sigPath As String, sigContent As String
    Dim oooDate As Date, oooTip As String
    
    ' 获取当前默认邮箱的自动回复配置
    Set oNamespace = Application.GetNamespace("MAPI")
    Set oStore = oNamespace.DefaultStore
    Set oAutoReply = oStore.GetAutoReplySettings
    
    ' 提取外出日期生成提示文本
    If oAutoReply.State = olAutoReplyEnabled Then
        oooDate = oAutoReply.EndTime
        oooTip = "<p style='color:#cc0000'>*即将外出：" & Format(oooDate, "yyyy年mm月dd日") & " 前无法及时回复*</p>"
    ElseIf oAutoReply.State = olAutoReplyScheduled Then
        oooDate = oAutoReply.StartTime
        oooTip = "<p style='color:#cc0000'>*即将外出：" & Format(oooDate, "yyyy年mm月dd日") & " 起将离线*</p>"
    Else
        oooTip = "" ' 无外出规则时清空提示
    End If
    
    ' 修改签名文件（默认签名路径可根据系统调整）
    sigPath = Environ("APPDATA") & "\Microsoft\Signatures\你的默认签名.htm"
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    sigContent = oFSO.OpenTextFile(sigPath, 1).ReadAll
    
    ' 替换签名中的标记位，可提前在签名里加<!--OOO_TIP-->作为占位符
    sigContent = Replace(sigContent, "<!--OOO_TIP-->", oooTip)
    oFSO.OpenTextFile(sigPath, 2).Write sigContent
    
    Set oFSO = Nothing
    Set oAutoReply = Nothing
    Set oStore = Nothing
    Set oNamespace = Nothing
End Sub

注意事项 #

• 需要提前在Outlook信任中心开启宏执行权限，或者对VBA工程做数字签名，避免运行时安全拦截
• 可以将宏绑定到Outlook启动事件、自动回复状态变更事件触发，无需手动执行
• 多账号场景下遍历oNamespace.Stores集合匹配对应邮箱即可，逻辑和上述代码一致

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