Select a mailitem in ActiveExplorer

Question

I have written a macro to open the path to a selected email in the results of the Outlook search.

The email is not automatically marked in the open folder so I search for the email in "ActiveExplorer". With .display, I can open the email, but I could not find a way to select the found email in "ActiveExplorer".

Public Sub MailOrdnerPfad()
  Dim obj As Object
  Dim Ordner As Outlook.MAPIFolder
  Dim Betreff As String
  Dim Mail As MailItem

  Set obj = Application.ActiveWindow
  If TypeOf obj Is Outlook.Inspector Then
    Set obj = obj.CurrentItem
  Else
    Set obj = obj.Selection(1)
  End If
  Betreff = obj.ConversationTopic
  Set Ordner = obj.Parent
    Set Application.ActiveExplorer.CurrentFolder = Ordner
    For Each Mail In Ordner.Items
        If Mail.ConversationTopic = Betreff Then
            Mail.Display
            Exit For
        End If
    Next
End Sub

Answer 1

Clear the original selection then add the found item.

Option Explicit


Public Sub MailOrdnerPfad()

    Dim obj As Object
    
    Dim Ordner As Folder
    Dim ordItem As Object
    
    Dim Betreff As String
    Dim myMail As MailItem

    Set obj = ActiveWindow
    If TypeOf obj Is Inspector Then
        Set obj = obj.CurrentItem
    Else
        Set obj = obj.Selection(1)
    End If
    
    If obj.Class = olMail Then
    
        Betreff = obj.ConversationTopic
        Debug.Print "Betreff: " & Betreff
    
        Set Ordner = obj.Parent
        Set ActiveExplorer.CurrentFolder = Ordner
        Debug.Print "Ordner.: " & Ordner
          
        For Each ordItem In Ordner.items
      
            If ordItem.Class = olMail Then
          
                Set myMail = ordItem
      
                Debug.Print "myMail.ConversationTopic: " & myMail.ConversationTopic
          
                If myMail.ConversationTopic = Betreff Then
                
                    ActiveExplorer.ClearSelection
                    ' myMail.Display
                    ActiveExplorer.AddToSelection myMail
              
                    Exit For
                End If
            End If
        Next
      
    End If
    
End Sub