Outlookで特定のフォルダ内のサブフォルダーの数を数えるにはどうすればよいですか？

Author: Siluvia Last Modified: 2025-05-23

例えば、ルートフォルダの下にいくつかのフォルダを作成したとします。では、そのルートフォルダの下にいくつのサブフォルダーがあるかを知りたい場合、どうすればよいでしょうか？ルートフォルダを展開してすべてのサブフォルダーを手動で一つずつ数えるだけですか？この記事では、それを簡単に実現する方法をご紹介します。

VBAコードを使用してサブフォルダーの数を数える

VBAコードを使用してサブフォルダーの数を数える

以下のVBAコードは、Outlookで特定のルートフォルダ内のサブフォルダーの数を数えるのに役立ちます。次の手順を行ってください。

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

2. Microsoft Visual Basic for Applications ウィンドウで、挿入 > モジュール をクリックします。その後、以下のVBAコードをコードウィンドウにコピーして貼り付けます。

VBAコード：Outlookで特定のフォルダ内のサブフォルダーの数を数える

Sub CountSubFldsUnderRootFolder()
Dim xRootFolder As Folder
Dim xFolderCount As Long
Dim xFolder As Object
On Error Resume Next
'Set xRootFolder = Outlook.Application.ActiveExplorer.CurrentFolder
Set xRootFolder = Outlook.Application.Session.PickFolder
If TypeName(xRootFolder) = "Nothing" Then Exit Sub
If xRootFolder.Folders.Count < 1 Then
    MsgBox "No subfolders under " & Chr(34) & xRootFolder.Name & Chr(34) & ".", vbInformation, "Kutools for Outlook"
    Exit Sub
End If
For Each xFolder In xRootFolder.Folders
    If xFolder.Name <> "Conversation Action Settings" And xFolder.Name <> "Quick Step Settings" Then
        xFolderCount = xFolderCount + 1
        Call ProcessFolders(xFolder, xFolderCount)
    End If
Next
MsgBox xFolderCount & " subfolders under " & Chr(34) & xRootFolder.Name & Chr(34) & ".", vbInformation, "Kutools for Outlook"
End Sub

Sub ProcessFolders(SubFolder As MAPIFolder, Num As Long)
Dim xSubFolder As MAPIFolder
On Error Resume Next
Num = Num + SubFolder.Folders.Count
For Each xSubFolder In SubFolder.Folders
    Call ProcessFolders(xSubFolder, Num)
Next
End Sub

3. F5キーを押してコードを実行します。

4. 開いた 「フォルダを選択」ダイアログボックスで、サブフォルダーを数えたいフォルダを選択し、OKボタンをクリックします。スクリーンショットをご覧ください：