空のフォルダを一括削除するマクロ

空のフォルダを一括で削除する方法を解説します。

フォルダ内の空のフォルダを一括削除する

ソースコード

Sub フォルダ内の空フォルダを削除する()
    
    Dim FSO As New FileSystemObject
    
    Dim 親フォルダ As Folder
    Set 親フォルダ = FSO.GetFolder("C:\Users\○○\Desktop\テスト")
    
    Dim 子フォルダ As Folder
    For Each 子フォルダ In 親フォルダ.SubFolders
        
        If 子フォルダ.Files.Count = 0 And _
           子フォルダ.SubFolders.Count = 0 Then
            子フォルダ.Delete
        End If
        
    Next
    
End Sub

解説

Dir関数は「フォルダ内のフォルダ」をループするのが苦手なため、
FileSystemObject(以下FSO)を使用したコードです。

FSOさえ知っていれば非常に読みやすいコードなので、
特に解説しなくても読めると思います。

1. GetFolderで取得した親フォルダの、
2. SubFoldersたちをForEachで1つずつ取り出し、
3. 孫にあたるFilesとSubFoldersのCountが共に0なら、
4. その子フォルダをDeleteする

という流れのコードなので、ほぼ文章みたいに読めるコードですね。

関数化

上記のコードは「親フォルダのパス」しかパラメータがありませんので、
容易に関数化が可能です。

Sub フォルダ内の空フォルダを削除する(対象フォルダパス As String)
    
    Dim FSO As New FileSystemObject
    
    Dim 親フォルダ As Folder
    Set 親フォルダ = FSO.GetFolder(対象フォルダパス)
    
    Dim 子フォルダ As Folder
    For Each 子フォルダ In 親フォルダ.SubFolders
        
        If 子フォルダ.Files.Count = 0 And _
           子フォルダ.SubFolders.Count = 0 Then
            子フォルダ.Delete
        End If
        
    Next
    
End Sub

' 実行例
Call フォルダ内の空フォルダをすべて削除する("C:\Users\○○\Desktop\テスト")

対象フォルダパスを引数にしただけですね。

これでこの処理を他のマクロに使いまわししやすくなりますし、
メインコードの記述も1行になって読みやすくなります。

変更箇所が少ないコードは関数化が簡単ですので、
積極的に使っていきましょう。

下層フォルダ内のすべての空フォルダを削除する

指定フォルダの下層フォルダを最下層まで検索し、
存在する空のフォルダをすべて削除するマクロがこちらです。

ソースコード

Public FSO As New FileSystemObject

Sub 実行プロシージャ()
    
    Call 下層フォルダ内のすべての空フォルダを削除する("C:\Users\○○\Desktop\テスト")
    
End Sub

Sub 下層フォルダ内のすべての空フォルダを削除する(対象フォルダパス As String)
    
    Dim 親フォルダ As Folder
    Set 親フォルダ = FSO.GetFolder(対象フォルダパス)
    
    ' すべてのサブフォルダをループ処理
    Dim 子フォルダ As Folder
    For Each 子フォルダ In 親フォルダ.SubFolders
        
        ' フォルダが空ならフォルダを削除
        If 子フォルダ.Files.Count = 0 And _
           子フォルダ.SubFolders.Count = 0 Then
            子フォルダ.Delete
        
        ' そうでなければそのサブフォルダに自身を呼出(再帰)
        Else
            Call 下層フォルダ内のすべての空フォルダを削除する(子フォルダ.Path)
        End If
        
    Next
    
End Sub

解説

冒頭の「フォルダが空なら削除する」コードに、
「空でないフォルダに自分自身を実行する」処理を追加したコードです。

このように自分自身をCallすることを「再帰呼出」と呼び、
自分自身をCallしている関数を「再帰関数」と呼びます。

VBAではこの「すべての下層フォルダの取得・処理」でよく登場し、

フォルダに対する処理をサブフォルダにも実行する

という再帰呼出で、最深部までフォルダを検索できます。

このフォルダに対する再帰処理の詳しい説明はこちらをどうぞ。

あとは複数の関数でFSOを使う際、Public変数にしてしまう方法も覚えておきましょう。

どこかのモジュールの冒頭で

Public FSO As New FileSystemObject

としておくだけで、各プロシージャで宣言する手間が省けます。

細かい仕様

上記のコードは「削除してから1つ下の階層へ」という順番のため、

このフォルダ構成の場合にAは削除されません。

BとCは削除されるのでAも空フォルダになるのですが、
そうなるのは「空かどうかの判定が終わった後」だからです。

このAフォルダも削除するマクロにしたい場合は、
削除と再帰の順番を逆にした以下のマクロにすればOKです。

Public FSO As New FileSystemObject

Sub 実行プロシージャ()
    
    Call 下層フォルダ内のすべての空フォルダを削除する("C:\Users\○○\Desktop\テスト")
    
End Sub

Sub 下層フォルダ内のすべての空フォルダを削除する(対象フォルダパス As String)
    
    Dim 親フォルダ As Folder
    Set 親フォルダ = FSO.GetFolder(対象フォルダパス)
    
    ' すべてのサブフォルダをループ処理
    Dim 子フォルダ As Folder
    For Each 子フォルダ In 親フォルダ.SubFolders
        
        ' すべてのサブフォルダに自身を呼出(再帰)
        Call 下層フォルダ内のすべての空フォルダを削除する(子フォルダ.Path)
        
        ' フォルダが空ならフォルダを削除
        If 子フォルダ.Files.Count = 0 And _
           子フォルダ.SubFolders.Count = 0 Then
            子フォルダ.Delete
        End If
        
    Next
    
End Sub

これで「空フォルダしかない親フォルダ」も削除されるようになります。

やりたい内容にあった方をお使いください。