如何在启动 Outlook 时自动展开所有文件夹？

作者Kelly修改日期2024-09-18

通常情况下，在 Outlook 的导航窗格中展开或折叠文件夹后关闭程序，重新打开 Outlook 时，文件夹会保持之前的状态。但如果您希望每次启动 Outlook 时自动展开所有文件夹，该如何操作呢？本文将为您提供一套 VBA 解决方案。

使用 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

保存代码后，关闭 Microsoft Visual Basic for Applications 窗口。

从现在开始，每次重启 Outlook 时，所有文件夹都会在 Outlook 中自动展开。

注意：

此 VBA 在重启 Outlook 后无法自动展开已折叠的搜索文件夹。
为确保 VBA 脚本顺利运行，您需在 Outlook 中调整宏设置。请依次点击文件 > 选项 > 信任中心 > 信任中心设置 > 宏设置，然后选择启用所有宏。此设置可让 VBA 脚本无障碍运行。

Outlook AI 邮件助手：智能回复，沟通更高效清晰（只需一键，轻松体验神奇效果！）

通过 Kutools for Outlook 的 AI 邮件助手，轻松提升您的日常 Outlook 工作效率。该强大工具能够智能学习您的邮件习惯，提供高效、精准的回复建议，优化邮件内容，助您轻松起草和润色邮件。

该功能支持：

智能回复：根据您的历史对话内容生成个性化且精准的回复，随时为您所用。
内容优化：自动完善您的邮件文本，让表达更加清晰且更具影响力。
轻松写作：您只需输入关键词，剩下的交给 AI，多种润色风格随心选择。
智能扩展：结合上下文，智能拓展您的想法，提供精准建议。
智能摘要：轻松为冗长邮件快速生成简明概览，让信息一目了然。
全球畅邮：轻松将邮件翻译为任意语言。

该功能支持：

智能邮件回复
内容优化
关键词草稿
智能内容扩展
邮件摘要
多语言翻译

立即行动——现在就下载 AI 邮件助手，畅享高效体验，不容错过！

在 Outlook 中批量删除多个文件夹

在 Outlook 的邮件文件夹中删除所有重复邮件

最佳办公效率工具

体验全新 Kutools for Outlook，畅享 100+ 强大功能！立即点击下载，不容错过！

🤖KUTOOLS AI：采用先进 AI 技术，轻松处理邮件，涵盖回复、摘要、优化、扩展、翻译及撰写等功能。

📧 邮件自动化：自动答复（支持 POP 和 IMAP）/定时发送邮件/发送邮件时按规则自动抄送密送/自动转发（高级规则）/自动添加称呼/自动将多收件人邮件拆分为单独信息……

📨 邮件管理：撤回邮件/按主题等条件拦截诈骗邮件/删除重复邮件/高级搜索/整合文件夹……

📁 附件增强：批量保存/批量分离/批量压缩/自动保存/自动拆离/自动压缩……

👍 一键精彩功能：带附件全部答复/反钓鱼邮件/🕘显示发送者当前时间时区……

👩🏼‍🤝‍👩🏻 联系人与日历：批量从选定邮件中提取添加联系人/将联系人组拆分为个人组/移除生日提醒……

在您的首选语言中畅享 Kutools —— 支持英语、西班牙语、德语、法语、中文等 40 多种语言！

一键解锁 Kutools for Outlook，告别等待，立即下载，让效率倍增！

Kutools for Outlook 功能列表立即下载前往购买

🚀 一键下载 — 即可获取全部 Office 加载项

强烈推荐：Kutools for Office（5 合 1）

一键下载五个安装包，即可同时获得 Kutools for Excel、Outlook、Word、PowerPoint 和 Office Tab Pro。立即点击下载！

✅ 一键便捷：只需一次操作，即可下载全部五个安装包。
🚀 轻松应对各类 Office 任务：随时按需安装所需插件，助您高效办公，不容错过！
🧰 包含：Kutools for Excel / Kutools for Outlook / Kutools for Word / Office Tab Pro / Kutools for PowerPoint

关于套件 ⬇ 下载套件 💳 购买套件