如何在啟動 Outlook 時自動展開所有資料夾？

Author: Kelly Last Modified: 2025-08-06

通常，當您展開或摺疊 Outlook 導航窗格中的某個資料夾並隨後關閉程式時，該資料夾會在重新打開 Outlook 時保持其展開或摺疊的狀態。然而，如果您希望每次啟動 Outlook 時所有資料夾都能自動展開，該怎麼辦呢？本文提供了一個 VBA 解決方案來實現這一功能。

使用 VBA 在啟動 Outlook 時自動展開所有資料夾

使用 VBA 在啟動 Outlook 時自動展開所有資料夾

本指南將演示如何使用 VBA 腳本在每次啟動 Outlook 時自動展開導航窗格中的所有資料夾。請按照以下步驟來實現該 VBA 腳本：

同時按下 Alt + F11 鍵以打開 Microsoft Visual Basic for Applications 窗口。

展開 Project 1 和 Microsoft Outlook Objects 在 Project 窗格中，雙擊打開 ThisOutlookSession 窗口，然後將以下 VBA 代碼粘貼到其中。

VBA：自動展開 Outlook 中的所有資料夾

Public WithEvents GEx As Explorer
Public GFlag As Boolean
Private Sub Application_Startup()
  'Update by ExtendOffice 2023/12/08
  Set GEx = Application.ActiveExplorer
  GFlag = False
End Sub

Private Sub GEx_SelectionChange()
  If GFlag = False Then
    ExpandAllFolders
  End If
  GFlag = True
End Sub

Public Sub ExpandAllFolders()
  Dim xNameSpace As Outlook.NameSpace
  Dim xFlds As Outlook.Folders
  Dim xCurrFld As Outlook.MAPIFolder
  Dim xFld As Outlook.MAPIFolder
  Dim xExpandDefaultStoreOnly As Boolean
  Dim xModule As NavigationModule
  On Error Resume Next
  xExpandDefaultStoreOnly = False
  Set xNameSpace = Application.Session
  Set xModule = Application.ActiveExplorer.NavigationPane.CurrentModule
  Set xCurrFld = Application.ActiveExplorer.CurrentFolder
  If xExpandDefaultStoreOnly = True Then
    Set xFld = xNameSpace.GetDefaultFolder(olFolderInbox)
    Set xFld = xFld.Parent
    Set xFlds = xFld.Folders
    LoopFolders xFlds, True
  Else
    LoopFolders xNameSpace.Folders, True
    LoopFolders xNameSpace.Folders, False
  End If
  DoEvents
  Set Application.ActiveExplorer.NavigationPane.CurrentModule = xModule
  Set Application.ActiveExplorer.CurrentFolder = xCurrFld
  Set xNameSpace = Nothing
  Set xModule = Nothing
  Set xCurrFld = Nothing
End Sub

Private Sub LoopFolders(Flds As Outlook.Folders, ByVal All As Boolean)
  Dim xFld As Outlook.MAPIFolder
  On Error Resume Next
  For Each xFld In Flds
    Select Case All
      Case True
        If xFld.DefaultItemType = olMailItem Then
          Set Application.ActiveExplorer.CurrentFolder = xFld
          DoEvents
          If xFld.Folders.Count > 0 Then
            LoopFolders xFld.Folders, All
          End If
        End If
      Case False
        Set Application.ActiveExplorer.CurrentFolder = xFld
        DoEvents
        If xFld.Folders.Count > 0 Then
          LoopFolders xFld.Folders, All
        End If
    End Select
  Next
End Sub