获取不在办公室的文本

Posted 2023-02-19

【中文标题】获取不在办公室的文本

【英文标题】：Get out-of-office text

【发布时间】：2018-12-13 17:49:31

【问题描述】：

我正在尝试获取电子邮件地址列表的所有外出消息。

我通过调用“.resolveAll”来强制控制名称函数。

如何获取我在屏幕上看到的外出消息，并将其复制到 Excel 中的字段中？

'Vba
Dim i As Integer
Dim Adres As String
i = 2 'Beginning at Row 2, Column 'H'
Do While Cells(i, 8).Value <> ""
    Adres = Cells(i, 8).Value
    With objMail
        .To = Adres
        .Display
        .Recipients.ResolveAll
'   ???How to get de message???        
    End With
    MsgBox ("OOO")
    i = i + 1
Loop

【参考方案1】：

您不太可能会像这样访问另一个收件箱，但出于好奇：

Private Sub readOutOfOfficeMessage()

    ' http://social.msdn.microsoft.com/Forums/en-US/outlookdev/thread/64ab56a0-005f-4ae7-845e-b7b476b9b11d/

    Dim myRecipient As recipient
    Dim sharedInbox As Folder
    Dim currItem As MailItem
    Dim oStorageItem As StorageItem

    ' Mail with out of office message
    Set currItem = ActiveInspector.currentItem

    ' For testing - only one recipient
    On Error Resume Next
    Set myRecipient = currItem.Recipients(1)
    On Error GoTo 0

    If Not myRecipient Is Nothing Then

        Debug.Print myRecipient.name

        ' GetSharedDefaultFolder is more used for
        '  other people's calendars, other folders, not inboxes
        Set sharedInbox = Session.GetSharedDefaultFolder(myRecipient, olFolderInbox)

        'sharedInbox.Display

        Set oStorageItem = sharedInbox.GetStorage("IPM.Note.Rules.OofTemplate.Microsoft", olIdentifyByMessageClass)

        Debug.Print oStorageItem.body

    End If

End Sub

假设您没有其他收件箱所需的访问权限。您可以查看自己的。

Private Sub readMyOwnOutOfOfficeMessage()

    ' http://social.msdn.microsoft.com/Forums/en-US/outlookdev/thread/64ab56a0-005f-4ae7-845e-b7b476b9b11d/

    Dim myInbox As Folder
    Dim oStorageItem As StorageItem

    Set myInbox = Session.GetDefaultFolder(olFolderInbox)

    'myInbox.Display

    Set oStorageItem = myInbox.GetStorage("IPM.Note.Rules.OofTemplate.Microsoft", olIdentifyByMessageClass)

    Debug.Print oStorageItem.body

End Sub