【VBA】空フォルダを検索する

こんにちは。
本日はVBAで空のフォルダを検索するサンプルです。

概要

フォルダの検索ダイアログで選択した場所の
空フォルダを出力します。
フォルダ選択ダイアログを表示するボタンと
検索開始ボタンを用意します。

サンプルソース

Option Explicit

Dim Fso As Object
Dim Path As String
Dim Ws As Worksheet

' 出力する開始行番号
Public Const StartRowIdx As Integer = 10

' 出力する列番号
Public Const ColIdx As Integer = 1

' 出力最大行数
Public Const MaxRowIdx As Integer = 100

' [1]フォルダ選択ダイアログを表示します。
' フォルダ選択ダイアログ表示ボタンに設定してください。
Sub SelectFolder()

    If Application.FileDialog(msoFileDialogFolderPicker).Show = True Then
        Path = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
    End If
End Sub

' [2]検索のメイン関数です。
' 検索開始ボタンに設定してください。
Sub SearchEmptyFolder()

    Set Ws = Worksheets(1)
    Call ClearOutputCell
    Set Fso = CreateObject("Scripting.FileSystemObject")
    
    Dim count As Integer: count = 0
    Dim f As Variant
    For Each f In Fso.GetFolder(Path).SubFolders
        If IsFileExist(f) = False And IsFolderExist(f) = False Then
            Ws.Cells(StartRowIdx + count, ColIdx).Value = f
            count = count + 1
        End If
    Next f
    Set Fso = Nothing
End Sub

' [3]出力行のセルをクリアします。
Sub ClearOutputCell()
 
    Dim rIdx As Integer
    rIdx = StartRowIdx
    Do While Ws.Cells(rIdx, ColIdx).Value <> ""
        If rIdx = MaxRowIdx Then
            Exit Do
        End If
        
        Ws.Cells(rIdx, ColIdx).Clear
        rIdx = rIdx + 1
    Loop
End Sub

' [4]ファイルの存在確認を行います。
Function IsFileExist(ByVal p As String) As Boolean

    Dim buf As String
    buf = Dir(p & "\" & "*")
    If buf = "" Then
        IsFileExist = False
    Else
        IsFileExist = True
    End If
End Function

' [5]フォルダの存在確認を行います。
Function IsFolderExist(ByVal p As String) As Boolean

    If Fso.GetFolder(p).SubFolders.Count = 0 Then
        IsFolderExist = False
    Else
        IsFolderExist = True
    End If
End Function

[1]ファイル選択ダイアログの出力

以前の記事で紹介しています。

nandakagoodvibes.hatenablog.com

[2]検索のメイン関数

前回の検索結果を[3]の関数でクリアしてから
サブフォルダを取得して、その中身を他の関数を使用して空か判定して出力します。
サブフォルダの取得は以下の記事で紹介しています。

nandakagoodvibes.hatenablog.com

[3]出力行のセルクリア

入力がある行を回してクリアする関数です。
以下の記事のサンプルを少し変えたものになります。

nandakagoodvibes.hatenablog.com

[4]ファイルの存在確認

以下の記事の応用になります。

nandakagoodvibes.hatenablog.com

以前の記事ではxlsmを検索していましたが
今回は空かどうかを判定したいので
buf = Dir(p & "\" & "*")としています。
結果に応じてtrue、falseを返します。

[5]フォルダの存在確認

SubFoldersプロパティのCountを使用して
サブフォルダ内のフォルダの数を取得します。
0だったら存在しないとして
結果に応じてtrue、falseを返します。

まとめ

気がついたら大量にフォルダを作っちゃったときに
作ったサンプルです。
あまり使わないかもですが、ちょっと便利なので紹介しました。
以上です。