在邮件的FROM字段中从Exchange用户提取SMTP地址

时间:2015-11-04 17:04:18

标签: vba outlook

我想按域(可能还有用户)组织文件夹中的邮件。我有一个脚本,但它无法从交换用户获取SMTP地址。以下代码摘自地址提取器。

///For each obj in objFolder.Items
    If obj.SenderEmailAddress = "EX" Then
    Set objSender = obj.Sender
        If Not (objSender Is Nothing) Then
            Set objExchUser = Sender.GetExchangeUser()
            If Not (objExchUser Is Nothing) Then
                strSender = objExchUser.PrimarySmtpAddress
            End If
        End If
    Else
        If obj.SenderEmailAddress = "" Then
        strSender = "ERROR@ERROR.GOV"
        Else
        MsgBox obj.SenderEmailAddress
        'MsgBox obj.PrimarySmtpAddress 'errs out
        'MsgBox Sender.GetExchangeUser() 'errs out
        'MsgBox Obj.Sender.GetExchangeUser() 'errs out
        strSender = obj.PrimarySmtpAddress
        End If
    End If
///Next

该代码适用于来自电子邮件组(例如helpdesk@myexchange.org)或欺骗性电子邮件地址的人员。

obj.SenderEmailAddress导致“/ O = EXCHANGELABS / OU = EXCHANGE ADMINISTRATIVE GROUP(removedtextforstack)/ CN = RECIPIENTS / CN = 7E2removedtextforstackF6-USERNAME”

我相信这是可以预料到的,但是Sender.GetExchangeUser()给出了一个Object Required错误。我并不特别想要3000行代码来挖掘AD以尝试查找每个电子邮件的AD代码/用户。我们使用Office 365并且由许多人管理,因此访问地址列表并不是一件容易的事。

2 个答案:

答案 0 :(得分:0)

我有一个似乎体面有效的解决方案。

Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"

a = Split(obj.PropertyAccessor.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS), vbCrLf)
For i = 0 To UBound(a)
    If InStr(1, a(i), "From:", vbTextCompare) = 1 Then
    MsgBox Replace(Split(a(i), "<")(1), ">", "")
    End If
Next

这会直接从标头中提取SMTP地址,而不关心它是什么类型的消息。

虽然还有更好的方法......

答案 1 :(得分:0)

MailItem.Sender.GetExchnageUser().ProimarySmtpAddress应该可以正常运行EX发件人,但您的代码会检查SenderEmailAddress属性而不是SenderEmailType。将其更改为

If obj.SenderEmailType = "EX" Then

在使用MailItem.Sender属性(更贵)之前,您还可以检查PR_SENT_REPRESENTING_SMTP_ADDRESS属性(DASL名称http://schemas.microsoft.com/mapi/proptag/0x5D02001F,使用MailItem.PropertyAccessor.GetProperty