Ordner suchen

Manche Anwender haben soviele Ordner, dass sie manchmal schon nicht mehr wissen, wo welcher denn nun zu finden ist. Außerdem kann es bei einer tiefen Ordnerhierarchie schon sehr aufwendig werden, sich durch alle zu klicken, um einen ganz bestimmten zu öffnen.

Folgendes Beispiel findet einen Ordner anhand des Namens und kann diesen wahlweise auch gleich aktivieren. Sie können entweder den kompletten Namen eingeben oder mithilfe von Platzhaltern nur einen Teil. Als Platzhalter werden '*' und '%' akzeptiert. Groß-/Kleinschreibung wird ignoriert. Beachten Sie die Konstante SpeedUp im Modulkopf: Mit der Standardeinstellung True läuft die Suche etwas schneller, Outlook ist während der Suche aber blockiert. Wenn die Suche aufgrund sehr vieler Ordner zu lange dauert und Sie währenddessen in Outlook weiterarbeiten wollen, dann ändern Sie den Wert auf False. Setzen Sie die Konstante StopAtFirstMatch auf False, wenn die Suche nicht beim ersten Treffer stoppen soll.

Kopieren Sie den Code ins Modul 'DieseOutlookSitzung'. Gestartet werden kann es z.B. mit alt+f8.

  So fügen Sie Makros in Outlook ein

Private m_Folder As Outlook.MAPIFolder
Private m_Find As String
Private m_Wildcard As Boolean

Private Const SpeedUp As Boolean = True
Private Const StopAtFirstMatch As Boolean = True

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

  Set m_Folder = Nothing
  m_Find = ""
  m_Wildcard = False

  Name = InputBox("Ordnername:", "Ordner suchen")
  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("Ordner aktivieren: " & vbCrLf & m_Folder.FolderPath, vbQuestion Or vbYesNo) = vbYes Then
      Set Application.ActiveExplorer.CurrentFolder = m_Folder
    End If
  Else
    MsgBox "Nicht gefunden", vbInformation
  End If
End Sub

Private Sub LoopFolders(Folders As Outlook.Folders)
  Dim F As Outlook.MAPIFolder
  Dim Found As Boolean
  
  If SpeedUp = False Then DoEvents

  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
      If StopAtFirstMatch = False Then
        If MsgBox("Gefunden: " & vbCrLf & F.FolderPath & vbCRLF & vbCrLf & "Weitersuchen?", vbQuestion Or vbYesNo) = vbYes Then
          Found = False
        End If
      End If
    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