Outlook で空のフォルダーを一括削除するにはどうすればよいですか？

特定のOutlook フォルダー内の空のサブフォルダーをすべて削除するには、以下の手順に従ってください。

1。「Alt」キーと「F11」キーを押して、Microsoft Visual Basic for Applications ウィンドウを開きます。

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。表示された「フォルダーの選択」ダイアログボックスで、空のサブフォルダーを一括削除したい対象のフォルダーを選択し、「OK」ボタンをクリックします。

 

5。これで「Kutools for Outlook」ダイアログボックスが表示され、削除された空のサブフォルダーの数が示されます。「OK」ボタンをクリックして閉じてください。

これにより、指定したOutlook フォルダー内のすべてのサブフォルダーが一括で正常に削除されました。