Note: The other languages of the website are Google-translated. Back to English

如何批量删除Outlook中的所有空文件夹?

假设Outlook中的邮件文件夹下有数十个空文件夹,通常我们可以通过右键单击菜单来逐个删除这些空文件夹。 与反复单击右键相比,本文将介绍一种VBA,以快速批量删除一个Outlook文件夹的所有空子文件夹。

使用VBA批量删除Outlook中的所有空文件夹

Office选项卡-在Office中启用选项卡式编辑和浏览,并使工作更加容易...
Kutools for Outlook-为Microsoft Outlook带来100种强大的高级功能
  • 自动CC / BCC 根据规则发送电子邮件; 自动转发 按规则发送多封电子邮件; 自动回复 没有交换服务器,还有更多自动功能...
  • BCC警告 -如果您的邮件地址在密件抄送列表中,则当您尝试全部答复时显示消息; 缺少附件时提醒,还有更多提醒功能...
  • 回复(全部)带有所有附件 在邮件对话中; 一次回复许多电子邮件; 自动添加问候语 回复时自动将日期和时间添加到主题中...
  • 附件工具:自动分离,全部压缩,重命名,自动保存所有... 快速报告,计算所选邮件, 删除重复的邮件和联系人...
  • 超过100种高级功能将 解决您的大部分问题 在 Outlook 2021 - 2010 或 Office 365 中。完整功能 60 天免费试用。

箭头蓝色右气泡使用VBA批量删除Outlook中的所有空文件夹

要删除某个Outlook文件夹的所有空子文件夹,请执行以下操作:

1。 按 其他 + F11 键以打开“ Microsoft Visual Basic应用程序”窗口。

2。 点击 插页 > 模块,然后将以下VBA代码粘贴到新的模块窗口中。

VBA:批量删除某些Outlook文件夹的所有空子文件夹

Public Sub DeletindEmtpyFolder()
Dim xFolders As Folders
Dim xCount As Long
Dim xFlag As Boolean
Set xFolders = Application.GetNamespace("MAPI").PickFolder.Folders
Do
FolderPurge xFolders, xFlag, xCount
Loop Until (Not xFlag)
If xCount > 0 Then
MsgBox "Deleted " & xCount & "(s) empty folders", vbExclamation + vbOKOnly, "Kutools for Outlook"
Else
MsgBox "No empty folders found", vbExclamation + vbOKOnly, "Kutools for Outlook"
End If
End Sub

Public Sub FolderPurge(xFolders, xFlag, xCount)
Dim I As Long
Dim xFldr As Folder 'Declare sub folder objects
xFlag = False
If xFolders.Count > 0 Then
For I = xFolders.Count To 1 Step -1
Set xFldr = xFolders.Item(I)
If xFldr.Items.Count < 1 Then 'If the folder is empty check for subfolders
If xFldr.Folders.Count < 1 Then 'If the folder contains not sub folders confirm deletion
xFldr.Delete 'Delete the folder
xFlag = True
xCount = xCount + 1
Else 'Folder contains sub folders so confirm deletion
FolderPurge xFldr.Folders, xFlag, xCount
End If
Else 'Folder contains items or (subfolders that may be empty).
FolderPurge xFldr.Folders, xFlag, xCount
End If
Next
End If
End Sub

3。 按 F5 键或 运行 按钮以运行此VBA代码。

4。 在弹出的“选择文件夹”对话框中,选择要批量删除其空子文件夹的特定文件夹,然后单击 OK 按钮。 看截图:

5。 现在出现了Kutools for Outlook对话框,并显示了删除了多少个空子文件夹。 点击 OK 按钮关闭它。

到目前为止,已批量删除了指定Outlook文件夹的所有子文件夹。


箭头蓝色右气泡相关文章

在Outlook中按文件夹名称查找文件夹(完整的文件夹路径)


Kutools for Outlook-为Outlook带来100个高级功能,并使工作更加轻松!

  • 自动CC / BCC 根据规则发送电子邮件; 自动转发 自定义多封电子邮件; 自动回复 没有交换服务器,还有更多自动功能...
  • BCC警告 -当您尝试全部答复时显示消息 如果您的邮件地址在“密件抄送”列表中; 缺少附件时提醒,还有更多提醒功能...
  • 在邮件对话中回复(全部)带有所有附件; 回复许多电子邮件 很快; 自动添加问候语 回复时将日期添加到主题中...
  • 附件工具:管理所有邮件中的所有附件, 自动分离, 全部压缩,全部重命名,全部保存...快速报告, 计算选定的邮件...
  • 强大的垃圾邮件 习俗 删除重复的邮件和联系人... 使您能够在Outlook中做得更聪明,更快和更好。
拍摄kutools前景kutools选项卡1180x121
拍摄kutools前景kutools加标签1180x121
 
按评论排序
注释 (10)
还没有评分。 成为第一位评论!
该评论由网站上的主持人最小化
辉煌!!!
该评论由网站上的主持人最小化
运行上述“运行时错误'-2147352567(80020009)'时出现以下错误无法删除此文件夹。右键单击该文件夹,然后单击属性以检查您对该文件夹的权限。请参阅文件夹所有者或您的管理员更改您的权限”

脚本似乎将 1 个项目移动到已删除的文件夹,然后出错。
该评论由网站上的主持人最小化
同意 - 我得到同样的错误。
该评论由网站上的主持人最小化
该脚本尝试删除已删除的文件夹。
我在 xFlag = False 之后添加了一行内容:
错误继续下一步
该评论由网站上的主持人最小化
确实,添加:

出错时继续下一步

后:

Dim x Fldr As Folder '声明子文件夹对象
xFlag = 假

它应该是这样的:

Dim x Fldr As Folder '声明子文件夹对象
xFlag = 假
出错时继续下一步
该评论由网站上的主持人最小化
我遇到了像布莱恩一样的错误....现在呢?
该评论由网站上的主持人最小化
该脚本尝试删除已删除的文件夹。
我在 xFlag = False 之后添加了一行内容:
错误继续下一步
该评论由网站上的主持人最小化
超级简单而且非常有帮助。 谢谢!!
该评论由网站上的主持人最小化
74 个空文件夹被删除,但不幸的是还有 109 个文件夹没有被删除。 其他空文件夹保持不变。
该评论由网站上的主持人最小化
这对我很有用。 谢谢你。 某些文件夹无法删除,因为它们是 Outlook 的原生文件夹,但子文件夹效果很好。
这里还没有评论

关注我们

版权所有 © 2009 - extendoffice.com。 | 版权所有。 供电 ExtendOffice。 | 网站地图
Microsoft和Office徽标是Microsoft Corporation在美国和/或其他国家的商标或注册商标。
受Sectigo SSL保护