Results 1 to 3 of 3

Thread: get smtp address from selected Folder in Outlook ( Shared )

Hybrid View

Previous Post Previous Post   Next Post Next Post
  1. #1
    VBAX Newbie
    Sep 2011

    get smtp address from selected Folder in Outlook ( Shared )

    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
    Last edited by Aussiebear; 04-08-2022 at 03:30 PM. Reason: Added code tags to supplied code

  2. #2
    VBAX Newbie
    Sep 2011
    i resolved it, but it seems i can not paste the new code

  3. #3
    VBAX Newbie
    Sep 2011
    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"
          '  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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts