【VBA】空フォルダの一覧を作成する

VBAコード

可読性や保守性を良くするために、処理を以下の2つに分けて作成します。

呼び出し関係は以下です。

ここでは例として
　・フォルダ「C:\Users\user\Desktop\test」配下の空フォルダの一覧を
　・シート「sample」に作成
します。
※サブフォルダ配下の空フォルダも対象です。
※ついでに列幅の自動調整もします。

Option Explicit

'WindowsAPI PathIsDirectoryEmpty
Declare PtrSafe Function PathIsDirectoryEmpty Lib "SHLWAPI.DLL" Alias "PathIsDirectoryEmptyA" (ByVal pszPath As String) As Boolean

'**********************************************************
'メイン処理
'**********************************************************
Sub main()
    
    Dim inputFolder As String
    Dim fso As Object
    Dim folder As Object
    Dim dicEmptyFolder As Object
    Dim outputSheet As Worksheet
    Dim writeRow As Long
    Dim writeColumn As String
    Dim key As Variant
    
    '対象フォルダ
    inputFolder = "C:\Users\user\Desktop\test"
    '出力先シート
    Set outputSheet = Worksheets("sample")
    '出力行 ※ここでは出力開始行を指定
    writeRow = 2
    '出力列
    writeColumn = "B"
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set dicEmptyFolder = CreateObject("Scripting.Dictionary")
    
    '空フォルダ一覧作成を実行
    Call createDicEmptyFolder(inputFolder, outputSheet, fso, dicEmptyFolder)
    
    If dicEmptyFolder.Count <> 0 Then
        '出力先シートに空フォルダ一覧を作成
        For Each key In dicEmptyFolder.Keys
            outputSheet.Cells(writeRow, writeColumn) = key
            writeRow = writeRow + 1
        Next
        '列幅を自動調整
        outputSheet.Columns(writeColumn).AutoFit
        MsgBox "空フォルダ一覧を作成しました。"
    Else
        MsgBox "空フォルダは存在しませんでした。"
    End If
    
    '後片付け
    Set fso = Nothing
    Set dicEmptyFolder = Nothing

End Sub

'**********************************************************
'空フォルダ一覧作成
'**********************************************************
Private Function createDicEmptyFolder(ByVal inputFolder As String, _
                                      ByVal outputSheet As Worksheet, _
                                      ByVal fso As Object, _
                                      ByRef dicEmptyFolder As Object)

    Dim folder As Object

    'サブフォルダの数だけ自身を再帰呼び出し
    For Each folder In fso.GetFolder(inputFolder).SubFolders
        Call createDicEmptyFolder(folder.Path, outputSheet, fso, dicEmptyFolder)
    Next

    '空フォルダの一覧を作成
    If PathIsDirectoryEmpty(inputFolder) = 1 Then
        dicEmptyFolder.Add inputFolder, "dummy"
    End If

End Function

実行結果

空フォルダの一覧を作成できました。
※列幅の自動調整もできました。

参考①

上記のVBAコードは以下の記事を参考にして作成しました。

詳細は以下の記事をご確認ください。

参考②

空フォルダを一括で削除することもできます。

詳細は以下の記事をご確認ください。

参考③

本記事の内容は
　・いただいた問い合わせを参考にして作成
しました。