VBOffice

Find a Folder by its Name

Don't remember where to find a given folder? With this script you can find the folder by its name.

Last modified: 2015/03/07 | Accessed: 78.457  | #82
◀ Previous sample Next sample ▶
OLKeeper OLKeeper
OLKeeper reliably prevents users from closing their Outlook window and thus possibly missing reminders or e-mails.

Some people have so many folders that they've got problems to find them. And with a deep hierarchy of folders it can also be a pain to click through all of them in order to activate a certain folder.

This example finds a folder by its name, and you can choose to get the found folder activated. You can either enter the full name, or use wildcards. '*' and '%' are allowed as wildcards. Upper/lower cases will be ignored. See the constant SpeedUp in the head of the module: The default setting of True means the search will be somewhat faster, however, Outlook will be blocked during the search. If the search takes too long due to a great many folders, you can set the value to False.

Copy the code into the module 'ThisOutlookSession'. For instance, it can be started by pressing alt+f8.


tip  How to add macros to Outlook
Private m_Folder As Outlook.MAPIFolder
Private m_Find As String
Private m_Wildcard As Boolean

Private Const SpeedUp As Boolean = True

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
  
  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
      Set m_Folder = F
      Exit For
    Else
      LoopFolders F.Folders
      If Not m_Folder Is Nothing Then Exit For
    End If
  Next
End Sub
SAM SAM
SAM automatically sets the sending account, or sender address, and folder for sent items based on several criteria.
email  Send a message