How do you extract email addresses from the 'To' field in outlook?
It looks like, for email addresses outside of your organization, the SMTP address is hidden in emailObject.Recipients(i).Address
, though it doesn't seem to allow you to distinguish To/CC/BCC.
The Microsoft code was giving me an error, and some investigating reveals that the schema page is no longer available. I wanted a semicolon-delaminated list of email addresses that were either in my Exchange organization or outside of it. Combining it with another S/O answer to convert inner-company email display names to SMTP names, this does the trick.
Function getRecepientEmailAddress(eml As Variant)
Set out = CreateObject("System.Collections.Arraylist") ' a JavaScript-y array
For Each emlAddr In eml.Recipients
If Left(emlAddr.Address, 1) = "/" Then
' it's an Exchange email address... resolve it to an SMTP email address
out.Add ResolveDisplayNameToSMTP(emlAddr)
Else
out.Add emlAddr.Address
End If
Next
getRecepientEmailAddres = Join(out.ToArray(), ";")
End Function
If the email is inside your organization, you need to convert it to an SMTP email address. I found this function from another StackOverflow answer helpful:
Function ResolveDisplayNameToSMTP(sFromName) As String
' takes a Display Name (i.e. "James Smith") and turns it into an email address ([email protected])
' necessary because the Outlook address is a long, convoluted string when the email is going to someone in the organization.
' source: https://stackoverflow.com/questions/31161726/creating-a-check-names-button-in-excel
Dim OLApp As Object 'Outlook.Application
Dim oRecip As Object 'Outlook.Recipient
Dim oEU As Object 'Outlook.ExchangeUser
Dim oEDL As Object 'Outlook.ExchangeDistributionList
Set OLApp = CreateObject("Outlook.Application")
Set oRecip = OLApp.Session.CreateRecipient(sFromName)
oRecip.Resolve
If oRecip.Resolved Then
Select Case oRecip.AddressEntry.AddressEntryUserType
Case 0, 5 'olExchangeUserAddressEntry & olExchangeRemoteUserAddressEntry
Set oEU = oRecip.AddressEntry.GetExchangeUser
If Not (oEU Is Nothing) Then
ResolveDisplayNameToSMTP = oEU.PrimarySmtpAddress
End If
Case 10, 30 'olOutlookContactAddressEntry & 'olSmtpAddressEntry
ResolveDisplayNameToSMTP = oRecip.AddressEntry.Address
End Select
End If
End Function
Check out the Recipients collection object for your mail item, which should allow you to get the address: http://msdn.microsoft.com/en-us/library/office/ff868695.aspx
Update 8/10/2017
Looking back on this answer, I realized I did a bad thing by only linking somewhere and not providing a bit more info.
Here's a code snippet from that MSDN link above, showing how the Recipients object can be used to get an email address (snippet is in VBA):
Sub GetSMTPAddressForRecipients(mail As Outlook.MailItem)
Dim recips As Outlook.Recipients
Dim recip As Outlook.Recipient
Dim pa As Outlook.PropertyAccessor
Const PR_SMTP_ADDRESS As String = _
"http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
Set recips = mail.Recipients
For Each recip In recips
Set pa = recip.PropertyAccessor
Debug.Print recip.name &; " SMTP=" _
&; pa.GetProperty(PR_SMTP_ADDRESS)
Next
End Sub