Private Sub Address()
Dim Item As MailItem
 Dim recips As Outlook.Recipients
 Dim recip As Outlook.Recipient
 Dim pa As Outlook.propertyAccessor
 Dim Address As String

Set Item = Application.ActiveExplorer.Selection.Item(1)

' get recipients
Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
Set recips = Item.Recipients
 For Each recip In recips
 Set pa = recip.propertyAccessor
 Address = LCase(pa.GetProperty(PR_SMTP_ADDRESS))
 Debug.Print Address
 Next
 
 ' get sender

 Dim olEU As Outlook.ExchangeUser
 Dim oEDL As Outlook.ExchangeDistributionList
 Set recip = Application.Session.CreateRecipient(Item.SenderEmailAddress)

 If InStr(1, recip, "@") > 0 Then
 Debug.Print "External", recip
 End If
 
 If InStr(1, recip, "/") > 0 Then
 ' get name
 recip.Resolve
 Debug.Print "Internal", recip
' get address
     Select Case recip.AddressEntry.AddressEntryUserType
       Case OlAddressEntryUserType.olExchangeUserAddressEntry
         Set olEU = recip.AddressEntry.GetExchangeUser
         If Not (olEU Is Nothing) Then
            Debug.Print olEU.PrimarySmtpAddress
         End If
       Case OlAddressEntryUserType.olOutlookContactAddressEntry
         Set olEU = recip.AddressEntry.GetExchangeUser
         If Not (olEU Is Nothing) Then
            Debug.Print olEU.PrimarySmtpAddress
         End If
       Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry
         Set oEDL = recip.AddressEntry.GetExchangeDistributionList
         If Not (oEDL Is Nothing) Then
            Debug.Print olEU.PrimarySmtpAddress
         End If
     End Select
End If
 
End Sub