Jeg søger hjælp til at udvikle en rigtig god makro til Outlook til en super makro

Hejsa

Jeg har en meget stor Outlook postkasse med rigtig mange mapper/foldere (1000+). Outlook gør det ikke let at finde den rigtige mappe. Men jeg har for nogen tid siden fundet en fin kode, som jeg bruger i en makro. Den kan finde en mappe med en søgning i alle niveauer, og den returnerer mappens navn med fuld sti og kan flytte til mappen. Det er yderst fremragende. Jeg bringer koden nedenfor.

Jeg har 2 forbedringsønsker.

1. Hvis man f.eks. leder efter en mappe, der hedder "Invitationer", og man har flere af dem. Så søger man efter "Invitati*", og så finder makroen den første. Her kan man vælge at hoppe til mappe eller ikke. Hvis ikke, så stopper den. Forbedringen kunne være, at makroen søger videre indtil man finder den rigtige. Eller indtil man stopper den.

2. Når man har fundet mappen, så hopper den til mappen og gør den aktiv. Det kunne være super, hvis man som alternativ kunne vælge, at den ikke hopper til mappen, men placerer den ønskede mappe i (midten af) navigationsruden, mens det fortsat er den aktuelt valgte mappe (oftest Indbakken fra Foretrukne mapper), der fortsat er den aktive mappe. Alternativt at den mappe, som man finder, placeres øverst i den menu, der fremkommer, når man venstre klikker på en mail og vælger Flyt.

Det er ikke vigtigt om makroen samlet set ender på dansk eller engelsk.

Kan det lade sig gøre?

De allerbedste hilsner og god weekend

Jesper

=========================

Her kommer koden:

Public Sub FindFolder()
  Dim Name$
  Dim Folders As Outlook.Folders

  Set m_Folder = Nothing
  m_Find = ""
  m_Wildcard = False

  Name = InputBox("Find Name:", "Search Folder")
  If Len(Trim$(Name)) = 0 Then Exit Sub
  m_Find = Name

  m_Find = LCase$(m_Find)
  m_Find = Replace(m_Find, "%", "*")
  m_Wildcard = (InStr(m_Find, "*"))

  Set Folders = Application.Session.Folders
  LoopFolders Folders

  If Not m_Folder Is Nothing Then
    If MsgBox("Activate Folder: " & vbCrLf & m_Folder.FolderPath, vbQuestion Or vbYesNo) = vbYes Then
      Set Application.ActiveExplorer.CurrentFolder = m_Folder
    End If
  Else
    MsgBox "Not Found", vbInformation
  End If
End Sub

Private Sub LoopFolders(Folders As Outlook.Folders)
  Dim F As Outlook.MAPIFolder
  Dim Found As Boolean

  For Each F In Folders
    If m_Wildcard Then
      Found = (LCase$(F.Name) Like m_Find)
    Else
      Found = (LCase$(F.Name) = m_Find)
    End If

    If Found Then
      Set m_Folder = F
      Exit For
    Else
      LoopFolders F.Folders
      If Not m_Folder Is Nothing Then Exit For
    End If
  Next
End Sub