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