用Excel VBA获取发件人的电子邮件地址

我拉主题，接收日期和发件人的姓名用下面的代码：用Excel VBA获取发件人的电子邮件地址

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语句会说“如果发件人的电子邮件地址是“[email protected]”，然后执行该代码我试过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

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

来源

2016-01-21 Josh Whitfield

你是正确的，它应该是'SenderEmailAddress'财产。 –

我是否正确使用它在那个注释掉了If语句？因为该方法不起作用。 –

请看我编辑的答案。 –

使用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＃中执行此操作的链接。

来源

2016-01-21 11:23:50

我似乎无法在我的代码或独自工作，我该如何适应它？编辑：我注意到它打印到一些更多的调整后立即窗口，但它没有返回电子邮件地址，我可能能够得到这个工作，不管。如果可以，我会发布代码，谢谢。 –

恐怕我不知道为什么它没有返回任何电子邮件地址 - 请确保发布您的解决方案，如果你得到它的工作。 –

在即时窗口中，我得到了'/ O = * SET1 */OU = FIRST ADMINISTRATIVE GROUP/CN = RECIPIENTS/CN = * VARIABLE1 *'（我必须省略一些敏感信息，但所有返回的代码总是相同的，'variable1'总是不同的，因为这是发送者。）。我会编辑我的问题来解释我接下来要做什么。 –

不能只使用发送键来强制在Outlook中“控制+ k”？看起来像这样可以解决你的问题，并且可能会让代码变得简单。

尝试添加这个地方？

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

来源

2016-01-21 12:27:55

我个人建议不要使用发送密钥;这是一个等待发生的事故。 –

我明白你的意思，但我试图告诉我的代码“如果这封电子邮件说'[email protected]'，那么执行此代码：”。我无法弄清楚如何让VBA读取域名。 –

@Iturner是它的坏习惯，但如果没有其他选择，你可以确保将其专门设置为展望。 –

我落得这样做 varTest = Item.senderemailaddress If InStr(varTest, "BE WISER INSURANCE") > 0 Then 其检测设定的部分，将不会在任何电子邮件，我不想。非常感谢您的帮助，@ Iturner！

来源

2016-01-21 13:55:32

在大多数情况下，发件人的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

来源

2016-01-21 14:14:33

用Excel VBA获取发件人的电子邮件地址

回答

相关问题