Как массово удалить все пустые папки в Outlook?

Чтобы удалить все пустые подпапки определённой папки Outlook, выполните следующие действия:

1. Нажмите клавиши «Alt» + «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
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 xFldr.Folders.Count < 1 Then
xFldr.Delete
xFlag = True
xCount = xCount + 1
Else
FolderPurge xFldr.Folders, xFlag, xCount
End If
Else
FolderPurge xFldr.Folders, xFlag, xCount
End If
Next
End If
End Sub

3. Нажмите «F5» или щёлкните кнопку «Выполнить», чтобы запустить этот код VBA.

4. Во всплывающем диалоговом окне «Выбор папки» выберите нужную папку, пустые подпапки которой вы хотите удалить массово, и нажмите «ОК».

 

5. Теперь появится диалоговое окно Kutools для Outlook с указанием количества удалённых пустых подпапок. Нажмите «ОК», чтобы закрыть его.

На этом этапе все подпапки указанной папки Outlook успешно удалены массово.