使用 Excel VBA 获取发件人的 SMTP 电子邮件地址答案

【问题标题】：Get sender's SMTP email address with Excel VBA使用 Excel VBA 获取发件人的 SMTP 电子邮件地址
【发布时间】：2022-04-29 09:19:48
【问题描述】：

我使用以下代码提取主题、接收日期和发件人姓名：

Set InboxSelect = GetObject("", "Outlook.Application").GetNamespace("MAPI").PickFolder
i = 0: EmailCount = 0
EmailCount = InboxSelect.Items.Count
While i < EmailCount
    i = i + 1
    blastRow = Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
    LastRow = Sheets("Body").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
    With InboxSelect.Items(i)
        MsgBox (SenderEmailAddress)
        'If .senderemailaddress = "*@somethingSpecific.co.uk" Then
            'EmailCount = EmailCount + 1
            Sheets("Import Data").Range("A" & blastRow).Formula = .SenderName
            Sheets("Import Data").Range("B" & blastRow).Formula = Format(.ReceivedTime, "dd/mm/yyyy")
            Sheets("Import Data").Range("C" & blastRow).Formula = .Subject
            Sheets("Body").Range("A" & LastRow).Formula = .Body
        'End If
    End With
Wend

我现在想要实现的是一个 if 语句，它会说“如果发件人的电子邮件地址是 'anything@somethingSpecific.co.uk'，则执行该代码。我试过 SenderEmailAddress 但在消息框中测试时它返回空白。

编辑：/O=*SET1*/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=*VARIABLE1* 现在每次都使用以下代码在即时窗口中返回：

Set InboxSelect = GetObject("", "Outlook.Application").GetNamespace("MAPI").PickFolder
i = 0: EmailCount = 0
EmailCount = InboxSelect.Items.Count
While i < EmailCount
    For Each Item In InboxSelect.Items
        Debug.Print Item.senderemailaddress
        If Item.senderemailaddress = "/O=SET1/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=*" Then
            i = i + 1
            blastRow = Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
            LastRow = Sheets("Body").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
            With InboxSelect.Items(i)
                    Sheets("Import Data").Range("A" & blastRow).Formula = .SenderName
                    Sheets("Import Data").Range("B" & blastRow).Formula = Format(.ReceivedTime, "dd/mm/yyyy")
                    Sheets("Import Data").Range("C" & blastRow).Formula = .Subject
                    'PASTING BODY IS SLOW
                    Sheets("Body").Range("A" & LastRow).Formula = .Body
                'End If
            End With
        End If
    Next Item
Wend

我试图做的是使用通配符（*）作为返回消息中的变体，但没有奏效，有没有更好的方法来做到这一点？

【问题讨论】：

你是对的，应该是SenderEmailAddress属性。
我在注释掉的 If 语句中是否正确使用了它？因为那个方法行不通。
请看我编辑的答案。

标签： vba excel email outlook

【解决方案1】：

使用SenderEmailAddress 属性的示例根据需要返回电子邮件字符串。

Dim outlookApp As outlook.Application, oOutlook As Object
Dim oInbox As outlook.Folder, oMail As outlook.MailItem

Set outlookApp = New outlook.Application
Set oOutlook = outlookApp.GetNamespace("MAPI")
Set oInbox = oOutlook.GetDefaultFolder(olFolderInbox)

For Each oMail In oInbox.Items
    Debug.Print oMail.SenderEmailAddress
Next oMail

编辑：

问题在于.SenderEmailAddress 属性返回的是EX 地址，而我们想要的是SMTP 地址。对于任何内部电子邮件地址，它将返回EX 类型的地址。

要从内部电子邮件中获取SMTP 地址，您可以使用以下地址。

Dim outlookApp As Outlook.Application, oOutlook As Object
Dim oInbox As Outlook.Folder, oMail As Outlook.MailItem

Dim strAddress As String, strEntryId As String, getSmtpMailAddress As String
Dim objAddressentry As Outlook.AddressEntry, objExchangeUser As Outlook.ExchangeUser
Dim objReply As Outlook.MailItem, objRecipient As Outlook.Recipient

Set outlookApp = New Outlook.Application
Set oOutlook = outlookApp.GetNamespace("MAPI")
Set oInbox = oOutlook.GetDefaultFolder(olFolderInbox)

For Each oMail In oInbox.Items
    If oMail.SenderEmailType = "SMTP" Then

        strAddress = oMail.SenderEmailAddress

    Else

        Set objReply = oMail.Reply()
        Set objRecipient = objReply.Recipients.Item(1)

        strEntryId = objRecipient.EntryID

        objReply.Close OlInspectorClose.olDiscard

        strEntryId = objRecipient.EntryID

        Set objAddressentry = oOutlook.GetAddressEntryFromID(strEntryId)
        Set objExchangeUser = objAddressentry.GetExchangeUser()

        strAddress = objExchangeUser.PrimarySmtpAddress()

    End If

    getSmtpMailAddress = strAddress
    Debug.Print getSmtpMailAddress

Next oMail

如果电子邮件已经是SMTP，它将只使用 .SenderEmailAddress 属性返回地址。如果邮件是EX，那么它会使用.GetAddressEntryFromID()方法找到SMTP地址。

以上是我在this answer 上找到的修改代码。 Here 也是如何在 C# 中执行此操作的链接。

【讨论】：

我似乎无法在我的代码中或单独工作，我应该如何调整它？编辑：我注意到经过更多调整后它会打印到即时窗口，但它没有返回电子邮件地址，无论如何我都可以让它工作。如果可以的话，我会发布代码，谢谢。
恐怕我不知道为什么它没有返回任何电子邮件地址 - 如果你让它工作，请发布你的解决方案。
在即时窗口中，我得到/O=*SET1*/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=*VARIABLE1*（我不得不省略一些敏感信息，但所有返回的代码总是相同的，'variable1' 总是不同的，因为那是发件人。）。我将编辑我的问题以解释我接下来需要做什么。
绝对没有理由使用 MailItem.Reply 来获取发件人对象 - Outlook 2010 及更高版本公开了返回 AddressEntry 对象的 MailItem.Sender 属性。
我们中的一些人还没有迁移到 2010 ;)。但是，仍然感谢您的建议；到 2010 年时我会检查一下。

【解决方案2】：

Public Function GetSenderAddrStr(objMail As Outlook.MailItem) As String
 If objMail.SenderEmailType = "SMTP" Then
        GetSenderAddrStr = objMail.SenderEmailAddress
 Else
        GetSenderAddrStr = objMail.Sender.GetExchangeUser().PrimarySmtpAddress
 End If
End Function

【讨论】：

【解决方案3】：

在大多数情况下，发件人的 SMTP 地址将在单独的属性中提供，您可以使用 MailItem.PropertyAccessor 访问它 - 使用 OutlookSpy 查看现有邮件（我是其作者） - 单击 IMessage 按钮。

否则你可以使用ExchangeUser.PrimarySmtpAddress

在我的头顶：

on error resume next 'PropertyAccessor can raise an exception if a property is not found
if item.SenderEmailType = "SMTP" Then
  strAddress = item.SenderEmailAddress
Else
  'read PidTagSenderSmtpAddress
  strAddress  = item.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x5D01001F")
  if Len(strAddress) = 0 Then
    set objSender = item.Sender
    if not (objSender Is Nothing) Then
      'read PR_SMTP_ADDRESS_W 
      strAddress  = objSender.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x39FE001F")
      if Len(strAddress) = 0 Then
        'last resort
        set exUser = objSender.GetExchangeUser
        if not (exUser Is Nothing) Then
          strAddress = exUser.PrimarySmtpAddress
        End If
      End If
    End If
  En If
End If

【讨论】：

【解决方案4】：

你不能只使用发送键在 Outlook 中强制“Control+k”吗？似乎这可以解决您的问题，并且可能会简化一段代码。

尝试在某处添加这个？

 Application.SendKeys("^k")       'i believe this is correct syntax, never used this yet but i think it works

【讨论】：

我个人建议不要使用发送键；这是一场等待发生的意外。
我明白你的意思，但我试图告诉我的代码“如果这封电子邮件说'anything@somethingSpecific.co.uk'，然后执行此代码：”。我不知道如何让 VBA 读取域。
@Iturner 是的，这是不好的做法，但如果没有其他选项，您可以确保将其专门设置为 Outlook。

【解决方案5】：

我最终做了 varTest = Item.senderemailaddress If InStr(varTest, "BE WISER INSURANCE") > 0 Then 它检测到我不想要的任何电子邮件中都没有的设置部分。非常感谢您的帮助，@Iturner！

【讨论】：

【解决方案6】：

在大多数情况下，发件人的 SMTP 地址将在邮件本身的单独属性中可用（PidTagSenderSmtpAddress = 0x5D01001F，DASL 名称 "http://schemas.microsoft.com/mapi/proptag/0x5D01001F"），您可以使用 MailItem.PropertyAccessor 访问它 - 看看使用OutlookSpy（我是其作者）在现有消息上 - 单击 IMessage 按钮。

否则你可以使用ExchangeUser.PrimarySmtpAddress：它比读取PidTagSenderSmtpAddress 属性更昂贵。如果 ExchangeUser 失败，PidTagSenderSmtpAddress 也将起作用（如果用户从 GAL 中删除，或者您在与创建消息的配置文件不同的配置文件中查看邮件，则可能发生这种情况）

在我的头顶：

on error resume next 'PropertyAccessor can raise an exception if a property is not found
if item.SenderEmailType = "SMTP" Then
  strAddress = item.SenderEmailAddress
Else
  'read PidTagSenderSmtpAddress
  strAddress  = item.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x5D01001F")
  if Len(strAddress) = 0 Then
    set objSender = item.Sender
    if not (objSender Is Nothing) Then
      'read PR_SMTP_ADDRESS_W 
      strAddress  = objSender.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x39FE001F")
      if Len(strAddress) = 0 Then
        'last resort
        set exUser = objSender.GetExchangeUser
        if not (exUser Is Nothing) Then
          strAddress = exUser.PrimarySmtpAddress
        End If
      End If
    End If
  En If
End If

【讨论】：