'Get sender's SMTP 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

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

EDIT: /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?

Solution 1:^[1]

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

EDIT:

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.

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

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.

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

Solution 2:^[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

Solution 3:^[3]

In most cases, the sender's SMTP address will be available in a separate property, you can access it using MailItem.PropertyAccessor - take a look at an existing message using OutlookSpy (I am its author) - click IMessage button.

Otherwise you can use ExchangeUser.PrimarySmtpAddress

Off the top of my head:

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

Solution 4:^[4]

Cant you just use send keys to force "Control+k" in outlook? Seems like this would solve your issue and probably make for an easy slice of code.

try adding this somewhere?

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

Solution 5:^[5]

I ended up doing varTest = Item.senderemailaddress If InStr(varTest, "BE WISER INSURANCE") > 0 Then which detected the set section that wouldn't be in any emails I didn't want. Thanks very much for your help, @Iturner!

Solution 6:^[6]

In most cases, the sender's SMTP address will be available on the mesage itself in a separate property (PidTagSenderSmtpAddress = 0x5D01001F, DASL name "http://schemas.microsoft.com/mapi/proptag/0x5D01001F"), you can access it using MailItem.PropertyAccessor - take a look at an existing message using OutlookSpy (I am its author) - click IMessage button.

Otherwise you can use ExchangeUser.PrimarySmtpAddress: it is more expensive than reading the PidTagSenderSmtpAddress property. PidTagSenderSmtpAddress will also work if ExchangeUser fails (which can happen if the user was deleted from GAL or if you are looking at the message in a profile different from the one where the message was created)

Off the top of my head:

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

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution	Source
Solution 1	Community
Solution 2	FreeSoftwareServers
Solution 3
Solution 4	Doug Coats
Solution 5	Josh Whitfield
Solution 6	Dmitry Streblechenko

'Get sender's SMTP email address with Excel VBA

Solution 1:[1]

Solution 2:[2]

Solution 3:[3]

Solution 4:[4]

Solution 5:[5]

Solution 6:[6]