使用 VBA，有没有办法从我的会话的自动回复（外出）中检索日期？

Question

我正在尝试开发一个宏，将活动（或最近的）外出日期添加到我的签名中。有点像“即将到来的 OOO”信号。

为此，我需要从“自动回复”部分检索此类日期。

有没有办法找回它们？

Answer 1

感谢@Nathan_Sav 的提示。还使用以下页面寻求帮助：

https://4sysops.com/archives/automate-out-of-office-messages-in-outlook-with-visual-basic-for-applications-vba/

它对我有用，但我不得不摆脱标准签名：它对我仍然有用。它基于即将发生的事件，而不是自动回复配置。

需要在 ThisOutlookSession 中声明检查器以触发事件：

Private WithEvents CsInspect As Outlook.Inspectors

它可以在启动时激活，...

Private Sub Application_Startup()
    Call General_Handler
End Sub

...或在我可以设置为按钮的特定宏上：

Public Sub TurnOnSignature()
    Call General_Handler
End Sub

它将设置 with-events 变量...

Private Sub General_Handler()
    Set CsInspect = Application.Inspectors
End Sub

常数：

Const GrSgnName = "My Name (and position)"
Const GrSgnComp = "My Company"
Const GrSgnLocn = "My Location"
Const GrSngPhon = "My Phone Number"

Const SingGrL = "<br><br>"
Const SingGrE = "</p>"

将构建我的新签名的函数：

Function GralSignature() As String

Const SignStr = "<span style= 'font-family: Calibri;'>"
Const SignEnd = "</span>"
    
    GrlSignNm = GSignHTML1(GrSgnName, 13, False)
    GrlSignCo = GSignHTML1(GrSgnComp, 12, False)
    GrlSignLc = GSignHTML1(GrSgnLocn, 12, False)
    GrlSignPh = GSignHTML1(GrSngPhon, 12, False)
    GrlSignOO = GSignHTML1(Check_Next_OOOs(20), 12, True)
    GrlSigntr = GrlSignNm & GrlSignOO & GrlSignCo & GrlSignLc & GrlSignPh
    GrlSigntr = SignStr & SingGrL & GrlSigntr & SignEnd

GralSignature = GrlSigntr

End Function

向基于 HTML 的文本添加格式的辅助函数：函数 GSignHTML1(StrConvert As String, StrSz As Long, StrBl As Boolean) As String 将 SingGrS 调暗为字符串

SingGrS = "<p style= 'margin: 0; padding: 0; font-size: " & StrSz & ";"
If StrBl = True Then
    SingGrS = SingGrS & "font-weight: bold;"
End If
    SingGrS = SingGrS & "'>"

GSignHTML1 = SingGrS & StrConvert & SingGrE

End Function

循环处理当前日期和我指定的日期（基于日历）之间所有即将发生的外出事件的功能。它将尽快检索。

Function Check_Next_OOOs(VarDays As Long) As String

Dim OlNSpa_ As NameSpace
Dim OlMeets As Object
Dim OlItems As Items
Dim OlMeet_ As AppointmentItem
Dim DateStr As Date, DateEnd As Date, StrDStr As String, StrDEnd As String
Dim DateFlt As String, OOOStr As Date, OOOEnd As Date, SuccFlag As Boolean

DateStr = Date
DateEnd = Date + VarDays
StrDStr = "[START] >= " & Chr(34) & DateStr & Chr(34)
StrDEnd = "[END] <= " & Chr(34) & DateEnd & Chr(34)
DateFlt = StrDStr & " AND " & StrDEnd

Check_Next_OOOs = DateStr & "-" & DateEnd

Set OlNSpa_ = Application.GetNamespace("MAPI")
Set OlMeets = OlNSpa_.GetDefaultFolder(olFolderCalendar)
Set OlItems = OlMeets.Items.Restrict(DateFlt)
    OlItems.Sort "[START]"

For Each OlMeet_ In OlItems
    With OlMeet_
        If .BusyStatus = 3 Then
            Debug.Print .Subject, .Start, .End
            OOOStr = .Start
            OOOEnd = .End
            SuccFlag = True
            Exit For
        End If
    End With
Next OlMeet_

If SuccFlag = True Then
    If Format(OOOEnd, "hh:mm:ss") = "00:00:00" Then
        OOOEnd = OOOEnd - 1
    End If
Check_Next_OOOs = Format(OOOStr, "yyyy mmm dd") & " - " & Format(OOOEnd, "yyyy mmm dd")
Check_Next_OOOs = "OOO " & Check_Next_OOOs

Else: Check_Next_OOOs = ""
End If

End Function

最后，结果：

谢谢！

使用 VBA，有没有办法从我的会话的自动回复（外出）中检索日期？

Using VBA, is there a way to retrieve the dates from my session's Automatic Replies (Out Of Office)?

outlook

vba