如何解析联系人组/通讯组列表并获取SMTP电子邮件?

时间:2019-06-12 01:19:17

标签: outlook-vba

我已经为此工作了一段时间,感到很沮丧。我尝试了几种不同的方法来枚举联系人组并获取其成员的SMTP电子邮件。其他方法导致地址属性为空,从而导致PropertyAccessor方法出错。

Sub test()
    Dim oNs As NameSpace
    Dim oFdr As Folder
    Dim oItem As Object, oItems As Items
    Dim strArr(100) As String
    Dim oRec As Recipient, oRecs As Recipients
    Dim oEDL As ExchangeDistributionList
    Dim oAEs As AddressEntries, oAE As AddressEntry
    Dim i As Integer, j As Integer


    Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

    'The purpose of this procedure is to write the sender and recipient SMTP emails to string array (strArr).
    'This code is successful unless a recipient is a distribution list.  If a distribution list is encountered,
    'the error below occurs.

    Set oNs = Application.Session
    Set oNs = Application.GetNamespace("MAPI")
    Set oFdr = oNs.GetDefaultFolder(olFolderInbox).Parent
    Set oFdr = oFdr.Folders("!Test Ground")
    Set oItems = oFdr.Items

    For Each oItem In oItems
        If oItem.Class = olMail Then
            strArr(0) = GetSenderSMTP(oItem) 'this sub works fine.
            Debug.Print strArr(0)
            Set oRecs = oItem.Recipients
            Debug.Print oRecs.Count
            i = 0: j = 0
            For Each oRec In oRecs

                i = i + j + 1
                If oRec.AddressEntry.DisplayType <> olUser Then
                    Set oEDL = oRec.AddressEntry.GetExchangeDistributionList
                    'Attempt to parse out each member of a distribution list
                    Set oAEs = oEDL.GetExchangeDistributionListMembers
                    j = 0
                    For Each oAE In oAEs
                        j = j + 1
                        'Err 91 "Object variable or with block not set" occurs on the next line.
                        'I have also tried the .GetPrimarySMTP method
                        strArr(i + j) = oAE.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
                        Debug.Print strArr(i + j)
                    Next
                Else
                    strArr(i) = oRec.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
                    Debug.Print strArr(i)
                End If
            Next
        End If

    Next
End Sub

代码返回错误91对象或未设置块的情况。

0 个答案:

没有答案