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フォルダーのすべてのサブフォルダーが正常に一括削除されました。