Get sender's SMTP email address with Excel VBA - vba

Question

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 'anything#somethingSpecific.co.uk' 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?

Answer 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#.

Answer 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

Answer 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

Answer 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

Answer 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!

Answer 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