使用Excel VBA获取发件人的电子邮件地址 [英] Get sender's email address with Excel VBA

问题描述

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

I pull the Subject, received date and sender's name with the following code:

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语句，该语句将显示如果发件人的电子邮件地址为'[e-mail]'，则执行该代码. 我已经尝试过SenderEmailAddress，但是在消息框中进行测试时它返回空白.

What I'm trying to achieve now is an if statement that will say "If the sender's email address is '[e-mail]' then execute that code. I've tried SenderEmailAddress but it returns blank when tested in a message box.

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

/O=*SET1*/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=*VARIABLE1* is now being returned in the immediate window every time with the below code:

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

我试图做的是使用通配符(*)充当返回的消息的变体，但没有奏效，是否有更好的方法呢?

What I've attempted to do is use a wildcard symbol (the *) to act as the variation in the returned message but that hasn't worked, is there a better way to do this?

推荐答案

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

An example of when using the SenderEmailAddress property returns the e-mail string as required.

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类型的地址.

The issue is that what the .SenderEmailAddress property is returning the EX address, whereas we want the SMTP address. For any internal e-mail addresses, it will return the EX type address.

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

To get the SMTP address from an internal e-mail, you can use the below.

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地址.

If the e-mail is already SMTP it will just use the .SenderEmailAddress property to return the address. If the e-mail is EX then it will find the SMTP address by using the .GetAddressEntryFromID() Method.

以上是我在这个答案. 此处也是一个链接有关如何在C#中执行此操作.

The above is modified code from what I found on this answer. Here is also a link with how to do this within C#.

这篇关于使用Excel VBA获取发件人的电子邮件地址的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！