get smtp address from selected Folder in Outlook ( Shared )

[kriszty]

I know i can get the SMTP address if i select a folder inside outlook , but how can i do the same when a folder is a shared email address
this code works for a normal outlook email account but when i select a shared mailbox folder it gives an error..


Private Sub storeAddress_from_DisplayName()
Dim storeDisplayName As String
Dim storeSMTPAddress As String
Dim storeRecipient As Recipient
' DisplayName and PrimarySmtpAddress can be the same
storeDisplayName = ActiveExplorer.CurrentFolder.Store.DisplayName
Debug.Print " storeDisplayName: " & storeDisplayName
Set storeRecipient = Session.CreateRecipient(storeDisplayName)
If storeRecipient.AddressEntry.Type = "EX" Then
storeSMTPAddress = storeRecipient.AddressEntry.GetExchangeUser.PrimarySmtpAddress
Debug.Print " storeSMTPAddress: " & storeSMTPAddress
End If
End Sub

[kriszty]

i resolved it, but it seems i can not paste the new code :(

[kriszty]

Option Explicit

Private WithEvents olItem As Items
Public WithEvents olExplorer As Outlook.Explorer
Public WithEvents oMail As Outlook.MailItem
Private WithEvents oExpl As Explorer
Private WithEvents oItem As MailItem
Private bDiscardEvents As Boolean
Private WithEvents objinspectors As Outlook.Inspectors
Private WithEvents objMail As Outlook.MailItem



Private Sub Application_Startup()

Set objinspectors = Outlook.Application.Inspectors
Set olItem = Application.GetNamespace("MAPI").GetDefaultFolder(6).Items
Set olExplorer = Outlook.Application.ActiveExplorer
Set oExpl = Application.ActiveExplorer
bDiscardEvents = False

End Sub

Private Sub olExplorer_SelectionChange()

On Error Resume Next
Set oMail = olExplorer.Selection.item(1)
Set oItem = oExpl.Selection.item(1)

End Sub

Private Sub objinspectors_NewInspector(ByVal Inspector As Inspector)

'Get the current email

Dim olSel As Selection
Dim olFPath As String
Dim olItem As Object
Dim invoer As String

On Error Resume Next

Set olSel = Outlook.Application.ActiveExplorer.Selection
Set olItem = olSel.item(1)
olFPath = olItem.Parent.FolderPath

If olFPath Like "*Supp*" Then
' MsgBox
invoer = "email_address1"
Else
' MsgBox
invoer = "email_address2"
End If

If TypeOf Inspector.currentItem Is MailItem Then
Set objMail = Inspector.currentItem
'verzend vanaf naam=invoer
objMail.SentOnBehalfOfName = invoer
End If
'==================================
End Sub