depends, on your sercurity on the exchange server, most likely you cant but if the sercurity is lapse or has been set up without then this might work below
Attribute VB_Name = "basGetSenderAddy"
' *******************************************************************
' basGetSenderAddy
' Author: Sue Mosher, Slipstick Systems, sue@slipstick.com
' Date: 8 Sep 2000
' Ver: 1.0
' Desc: Demonstrates how to get the From and Reply To addresses
' from an Outlook message
' Unrestricted public use allowed of this code is allowed
' References: Microsoft Outlook 9.0 Object Library
' Microsoft CDO 1.21 Library
' *******************************************************************
Option Explicit
Const CdoE_ACCESSDENIED = 80070005
' *******************************************************************
' Name: ShowAddresses
' Desc: For currently displayed or selected message, prints both the
' From and Reply To addresses to the Immediate window
' In: Nothing
' Out: Nothing
' *******************************************************************
Sub ShowAddresses()
Dim obj As Object
Set obj = GetCurrentItem()
If obj.Class = olMail Then
Debug.Print GetFromAddress(obj)
Debug.Print GetReplyToAddress(obj)
End If
Set obj = Nothing
End Sub
' *******************************************************************
' Name: GetFromAddress
' Desc: Returns the address of the sender of the message
' In: MailItem object
' Out: From address unless an error is encountered. If there is an
' error, it returns "".
' *******************************************************************
Function GetFromAddress(objMsg As Outlook.MailItem)
Dim objSession As MAPI.Session
Dim objCDOMsg As MAPI.Message
Dim strEntryID As String
Dim strStoreID As String
Dim strAddress As String
' start CDO session
Set objSession = CreateObject("MAPI.Session"
objSession.Logon , , False, False
' pass message to CDO
strEntryID = objMsg.EntryID
strStoreID = objMsg.Parent.StoreID
Set objCDOMsg = objSession.GetMessage(strEntryID, strStoreID)
' get sender address
On Error Resume Next
strAddress = objCDOMsg.Sender.Address
If Err = CdoE_ACCESSDENIED Then
'handle possible security patch error
MsgBox "The Outlook E-mail and CDO Security Patches are " & _
"apparently installed on this machine. " & _
"You must response Yes to the prompt about " & _
"accessing e-mail addresses if you want to " & _
"get the From address.", vbExclamation, _
"GetFromAddress"
End If
GetFromAddress = strAddress
On Error GoTo 0
Set objCDOMsg = Nothing
objSession.Logoff
Set objSession = Nothing
End Function
' *******************************************************************
' Name: GetReplyToAddress
' Desc: Returns the reply address of the sender of the message
' In: MailItem object
' Out: Reply To address unless an error is encountered. If there is an
' error, it returns "".
' *******************************************************************
Function GetReplyToAddress(objMsg As Outlook.MailItem)
Dim objReply As Outlook.MailItem
Dim objRecip As Outlook.Recipient
Dim strAddress As String
Set objReply = objMsg.Reply
On Error Resume Next
Set objRecip = objReply.Recipients.Item(1)
If Err = 0 Then
' address will be in Name or Address depending
' on sending application and type of address
strAddress = objRecip.Address
If strAddress = "" Then
strAddress = objRecip.Name
End If
ElseIf Err = 287 Then
strAddress = ""
MsgBox "The Outlook E-mail Security Patch is " & _
"apparently installed on this machine. " & _
"You must response Yes to the prompt about " & _
"accessing e-mail addresses if you want to " & _
"get the Reply To address.", vbExclamation, _
"GetReplyToAddress"
End If
GetReplyToAddress = strAddress
On Error GoTo 0
Set objRecip = Nothing
Set objReply = Nothing
End Function
' *******************************************************************
' Name: GetCurrentItem
' Desc: Returns the Outlook item either currently displayed or, if
' the active window shows a folder, the first selected item
' In: Nothing
' Out: Outlook item
' *******************************************************************
Function GetCurrentItem() As Object
Dim objApp As Application
Dim objSel As Outlook.Selection
Dim objItem As Object
Set objApp = CreateObject("Outlook.Application"
Select Case objApp.ActiveWindow.Class
Case olExplorer
Set objSel = objApp.ActiveExplorer.Selection
If objSel.Count > 0 Then
Set objItem = objSel.Item(1)
End If
Case olInspector
Set objItem = objApp.ActiveInspector.CurrentItem
Case Else
' can't handle any other kind of window
End Select
Set GetCurrentItem = objItem
Set objItem = Nothing
Set objSel = Nothing
Set objApp = Nothing
End Function
