获取不在办公室的文字

Posted 2021-03-26

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

我通过调用“.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

答案

不太可能你可以访问另一个这样的收件箱，但作为一个好奇心：

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