检查电子邮件地址是否开启了自动回复 (OOF)

Question

我想遍历电子邮件地址列表并检查它们是否打开了 OOF（这些将是其他人的电子邮件地址）。然后如果可能检索 OOF 文本。

我尝试了通过 VBA 获取 OOF 的选项，但通过我自己的反复试验和谷歌搜索，我可以看到大多数人（和我自己）意识到只有获得您自己的 OOF 信息才有可能。

Sub Check_OOF()

    Dim oNS As Outlook.NameSpace
    Dim oStores As Outlook.Stores
    Dim oStr As Outlook.Store
    Dim oPrp As Outlook.PropertyAccessor

    Set oNS = Outlook.GetNamespace("MAPI")
    Set oStores = oNS.Stores

    For Each oStr In oStores
        If oStr.ExchangeStoreType = olPrimaryExchangeMailbox Then
            Set oPrp = oStr.PropertyAccessor
            MsgBox oPrp.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x661D000B")
        End If
    Next

End Sub

Outlook-Redemption 可以吗？我只能看到与您自己的自动回复进行交互的语法。

Answer 1

您将需要使用 EWS - GetMailTips operation。

您也可以使用 Redemption, see RDOMailTips object 获取更多信息。

Answer 2

感谢尤金为我指明正确的方向，也感谢德米特里的救赎。

我通过下载 here 并通过命令行安装来安装 redemption（感谢您的清晰说明）。我正在使用 RDOMailTips 对象，它允许我遍历邮箱并检索 OOF 消息和其他有用的信息。

下面是我快速编写的示例，用于展示循环浏览电子邮件并获取 OOF 文本和 start/end 日期的基本前提。

Sub Get_OOF()

Dim session As Redemption.RDOSession
Dim arr As Variant

Set session = CreateObject("Redemption.RDOSession")
session.Logon
session.SkipAutodiscoverLookupInAD = True

 arr = Array("user1@email.com", "user2@email.com", "user3@email.com")

 For i = LBound(arr) To UBound(arr)
    Set AdrEntry = session.AddressBook.ResolveName(arr(i))
    Set mailtips = AdrEntry.GetMailTips
    Debug.Print mailtips.OutOfOfficeMessage
    Debug.Print mailtips.OutOfOfficeEndTime
    Debug.Print mailtips.OutOfOfficeStartTime
Next i

Set session = Nothing
Set AdrEntry = Nothing
Set mailtips = Nothing

End Sub

注意四点

如果此人不在办公室，它将return一个空字符串
如果此人没有设置外出日期，它将 return 01/01/4501，我认为这是一个格式为日期的错误代码
您需要从 mailtips.OutOfOfficeMessage 中拆分字符串，因为它在外出文本周围有很多格式错误
我不需要将我的凭据放入 AdrEntry.GetMailTips 的参数中就可以正常工作。但正如文档所说，这对于 EWS 是可选的。

检查电子邮件地址是否开启了自动回复 (OOF)

Checking if an email address has automatic replies (OOF) turned on

vba

outlook

outlook-redemption