VBOffice

Expand All Folders

This sample expands your entire folder list.

Last modified: 2017/03/17 | Accessed: 78.423  | #57
◀ Previous sample Next sample ▶

Content

SAM SAM
Determine the "identity" of your emails. Set with SAM the sender and the folder folder for sent items with the help of rules.

All Stores Or DefaultStore Only

Do you have an extensive folder structure and must manually open it at every startup of Outlook? Sometimes Outlook does that for you - and frequently it doesn't. This sample opens all the tree at startup, and it's a spectacle...

There's a variable 'ExpandDefaultStoreOnly' in the procedure 'ExpandAllFolders'. With the current value (True) only the Personal Folder gets expanded. If you want to expand all available mailboxes (data stores, email accounts) then set the variable = False.


tip  How to add macros to Outlook
Private Sub Application_Startup()
  ExpandAllFolders
End Sub

Private Sub ExpandAllFolders()
  On Error Resume Next
  Dim Ns As Outlook.NameSpace
  Dim Folders As Outlook.Folders
  Dim CurrF As Outlook.MAPIFolder
  Dim F As Outlook.MAPIFolder
  Dim ExpandDefaultStoreOnly As Boolean

  ExpandDefaultStoreOnly = True

  Set Ns = Application.GetNamespace("Mapi")
  Set CurrF = Application.ActiveExplorer.CurrentFolder

  If ExpandDefaultStoreOnly = True Then
    Set F = Ns.GetDefaultFolder(olFolderInbox)
    Set F = F.Parent
    Set Folders = F.Folders
    LoopFolders Folders, True

  Else
    LoopFolders Ns.Folders, True
  End If

  DoEvents
  Set Application.ActiveExplorer.CurrentFolder = CurrF
End Sub

Private Sub LoopFolders(Folders As Outlook.Folders, _
  ByVal bRecursive As Boolean _
)
  Dim F As Outlook.MAPIFolder

  For Each F In Folders
    Set Application.ActiveExplorer.CurrentFolder = F
    DoEvents

    If bRecursive Then
      If F.Folders.Count Then
        LoopFolders F.Folders, bRecursive
      End If
    End If
  Next
End Sub
OLKeeper OLKeeper
OLKeeper reliably prevents users from closing their Outlook window and thus possibly missing reminders or e-mails.

Exclude Some Mailboxes

This sample is similar to the fist one. It opens all mailboxes and the subfolders. However, you can exclude a single mailbox by adding the name of its top folder to the variable 'Name' in the 'ExpandAllFolders' procedure. (In this sample the data store 'Personal Folders' will be skipped.) If you want to exclude several mailboxes, data stores, or email accounts, then simply copy the entire line, and again fit the folder name.

If you are unsure what the name of the top folder you want to exlude is, then run the macro without skipping any folder (comment out the respective line with the folder name). The macro prints the entire folder hierarchy to the immediate window (ctrl+g).

Private m_SkipThisFolder As VBA.Collection

Private Sub Application_Startup()
  ExpandAllFolders
End Sub

Private Sub ExpandAllFolders()
  On Error Resume Next
  Dim Ns As Outlook.NameSpace
  Dim Folders As Outlook.Folders
  Dim CurrF As Outlook.MAPIFolder
  Dim F As Outlook.MAPIFolder
  Dim Name As String
  
  Set m_SkipThisFolder = New VBA.Collection
  
  'Skip these folders
  Name = "Personal Folders": m_SkipThisFolder.Add Name, Name
  
  Set Ns = Application.GetNamespace("Mapi")
  Set CurrF = Application.ActiveExplorer.CurrentFolder

  LoopFolders Ns.Folders, True, 1

  DoEvents
  Set Application.ActiveExplorer.CurrentFolder = CurrF
End Sub

Private Sub LoopFolders(Folders As Outlook.Folders, _
  ByVal bRecursive As Boolean, _
  ByVal Level As Long _
)
  Dim F As Outlook.MAPIFolder
  Dim Skip As Boolean
  Dim Name As String
  
  For Each F In Folders
    Debug.Print String(Level - 1, "-") & F.Name
    Skip = False
    
    If Level = 1 Then
      On Error Resume Next
      Name = m_SkipThisFolder(F.Name)
      If Err.Number = 0 Then
        Skip = True
      End If
      On Error GoTo 0
    End If
    
    If Skip = False Then
      Set Application.ActiveExplorer.CurrentFolder = F
      DoEvents
  
      If bRecursive Then
        If F.Folders.Count Then
          LoopFolders F.Folders, bRecursive, Level + 1
        End If
      End If
    End If
  Next
End Sub
ReplyAll ReplyAll
ReplyAll alerts you before unintentionally replying all, or if you are a confidential BCC recipient of the e-mail.
email  Send a message