Script 2:
' Outlook VBA Script that gets SMTP Address of the Currently Selected Email
' This script can convert an Exchange address into an SMTP address
' Use Tools->Macro->Security to allow Macros to run, then restart Outlook
' Run Outlook, Press Alt+F11 to open VBA
' Programming by Greg Thatcher,
Option Explicit
Public Sub GetSmtpAddressOfCurrentEmail()
Dim Session As Outlook.NameSpace
Dim currentExplorer As Explorer
Dim Selection As Selection
Dim currentItem As Object
Dim currentMail As MailItem
Dim smtpAddress As String
Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection
'for all items do...
For Each currentItem In Selection
If currentItem.Class = olMail Then
Set currentMail = currentItem
smtpAddress = GetSmtpAddress(currentMail)
MsgBox "SMTP Address is " & smtpAddress
End If
Next
End Sub
Public Function GetSmtpAddress(mail As MailItem)
On Error GoTo On_Error
GetSmtpAddress = ""
Dim Report As String
Dim Session As Outlook.NameSpace
Set Session = Application.Session
If mail.SenderEmailType <> "EX" Then
GetSmtpAddress = mail.SenderEmailAddress
Else
Dim senderEntryID As String
Dim sender As AddressEntry
Dim PR_SENT_REPRESENTING_ENTRYID As String
PR_SENT_REPRESENTING_ENTRYID = "h_t_tp://schemas.microsoft.com/mapi/proptag/0x00410102"
senderEntryID = mail.PropertyAccessor.BinaryToString( _
mail.PropertyAccessor.GetProperty( _
PR_SENT_REPRESENTING_ENTRYID))
Set sender = Session.GetAddressEntryFromID(senderEntryID)
If sender Is Nothing Then
Exit Function
End If
If sender.AddressEntryUserType = olExchangeUserAddressEntry Or _
sender.AddressEntryUserType = olExchangeRemoteUserAddressEntry Then
Dim exchangeUser As exchangeUser
Set exchangeUser = sender.GetExchangeUser()
If exchangeUser Is Nothing Then
Exit Function
End If
GetSmtpAddress = exchangeUser.PrimarySmtpAddress
Exit Function
Else
Dim PR_SMTP_ADDRESS
PR_SMTP_ADDRESS = "h_t_tp://schemas.microsoft.com/mapi/proptag/0x39FE001E"
GetSmtpAddress = sender.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
End If
End If
Exiting:
Exit Function
On_Error:
MsgBox "error=" & Err.Number & " " & Err.Description
Resume Exiting
End Function