获取外出文字

时间:2018-07-05 09:39:27

标签: excel vba outlook

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

我通过调用“ .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 个答案:

答案 0 :(得分:0)

出于好奇,您不太可能像这样访问另一个收件箱:

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