VBAで指定フォルダ配下の一覧をソートして取得

指定フォルダ配下をFileSystemObjectで取得する、けどソートは？

VBAで指定フォルダ配下を取得するにはFileSystemObjectを利用します。

ただ、FileSystemObjectではフォルダやファイルが名前でソートされているとは限らないため、対応が必要になります。

大抵の場合はSubFoldersコレクションやFilesコレクションの先頭から順に取得すると名前順になっているようですが、コレクションのため本当に名前順なのかが不明でMicrosoftのヘルプにも明示されていない以上、やはりソート対策は必要になります。

以下で紹介する指定フォルダ配下のフォルダとファイルの一覧を取得するマクロは、フォルダ名とファイル名を昇順ソートした状態で取得します。

また、指定フォルダ内にフォルダとファイルがある場合はエクスプローラーでの表示とは異なり、先にファイルを取得し、そのあとにサブフォルダを取得するようにしています。これを逆にしてエクスプローラの表示と同じように、サブフォルダを先に取得する方法については後述します。

事前設定

以下のコードではFileSystemObjectを参照設定した状態になっていることが前提になります。

そのため、VBA画面のツールメニュー→参照設定を選び、Microsoft Scripting Runtimeにチェックする必要があります。

指定フォルダ内のフォルダとファイルの一覧を取得するマクロ

以下に２つの関数があります。SearchAllDirFile関数とinsertsortAsc関数です。メインとなるのは１つ目のSearchAllDirFile関数で、２つ目のinsertsortAsc関数は配列ソートに使っています。

１つ目のSearchAllDirFile関数の１つ目の引数に一覧を取得したいフォルダを指定し、２つ目の引数に一覧を格納する動的配列を指定します。詳細は後述の使い方を参照ください。

ここでは配列のソートに挿入ソートの仕組みを利用しています。

その理由は、SubFoldersコレクションやFilesコレクションは名前の昇順に並んでいることが多いようで、ソートが不要なことが多いように見えます。

そのため昇順で並んでいることが前提であれば、クイックソートよりも挿入ソートの方が高速のため、挿入ソートを採用しています。

なお、挿入ソートについては「VBAの配列を挿入ソートで並べ替え」で紹介しているコードをそのまま使っています。

'// 指定フォルダ配下のサブフォルダとファイルのリストを配列に格納
Sub SearchAllDirFile(a_sFolder, a_ArPath())
    Dim oFso                    As New FileSystemObject
    Dim oFolder                 As Folder
    Dim oSubFolder              As Folder
    Dim oFile                   As File
    Dim arPath()
    Dim i
    Dim sFile
    Dim sFolder
    
    '// フォルダがない場合
    If (oFso.FolderExists(a_sFolder) = False) Then
        Exit Sub
    End If
    
    '// 指定フォルダのFolderオブジェクト取得
    Set oFolder = oFso.GetFolder(a_sFolder)
    
    '// 指定フォルダ配下にファイルが存在する場合
    If (oFolder.Files.Count > 0) Then
        '// パス配列の領域をファイル数で初期化
        ReDim arPath(oFolder.Files.Count - 1)
        
        i = 0
        '// 指定フォルダ内のファイルを取得
        For Each oFile In oFolder.Files
            arPath(i) = oFile.Path
            i = i + 1
        Next
        
        '// 挿入ソートで整列
        Call insertsortAsc(arPath)
        
        '// ファイル数ループ
        For Each sFile In arPath
            '// 配列が初期化状態ではない場合
            If (IsEmpty(a_ArPath(0)) = False) Then
                '// 配列領域を拡張
                ReDim Preserve a_ArPath(UBound(a_ArPath) + 1)
            End If
            
            '// ファイルパスを登録
            a_ArPath(UBound(a_ArPath)) = sFile
        Next
    End If
    
    '// パス配列をクリア
    Erase arPath
    
    '// 指定フォルダ配下にサブフォルダが存在する場合
    If (oFolder.SubFolders.Count > 0) Then
        '// パス配列の領域をサブフォルダの数で初期化
        ReDim arPath(oFolder.SubFolders.Count - 1)
        
        i = 0
        '// 指定フォルダ内のサブフォルダを取得
        For Each oSubFolder In oFolder.SubFolders
            arPath(i) = oSubFolder.Path
            i = i + 1
        Next
        
        '// 挿入ソートで整列
        Call insertsortAsc(arPath)
        
        '// サブフォルダ数ループ
        For Each sFolder In arPath
            '// 配列が初期化状態ではない場合
            If (IsEmpty(a_ArPath(0)) = False) Then
                '// 配列領域を拡張
                ReDim Preserve a_ArPath(UBound(a_ArPath) + 1)
            End If
            
            '// フォルダパスを登録
            a_ArPath(UBound(a_ArPath)) = sFolder
            
            '// 再帰呼び出し
            Call SearchAllDirFile(sFolder, a_ArPath)
        Next
    End If
End Sub

'// 挿入ソート（昇順）
Sub insertsortAsc(a_Ar())
    Dim iNow                    '// ループカウンタ（現要素用）
    Dim iBefore                 '// ループカウンタ（前要素用）
    Dim temp                    '// 一時格納領域
    Dim iArrayCount             '// 配列要素数
    
    '// 配列の要素数を取得
    iArrayCount = UBound(a_Ar)
    
    '// 配列を２番目の要素から最後までループ
    For iNow = 1 To iArrayCount
        '// 配列の要素を一時格納
        temp = a_Ar(iNow)
        
        '// 前要素を取得
        iBefore = iNow - 1
        
        '// 前要素から先頭に向かってループ
        Do
            '// 配列要素外の場合
            If (iBefore < 0) Then
                Exit Do
            End If
            
            '// 入れ替える必要がない場合
            If (a_Ar(iBefore) <= temp) Then
                Exit Do
            End If
            
            '// 配列の前後を入れ替える
            a_Ar(iBefore + 1) = a_Ar(iBefore)
            
            '// 前要素を先頭側に移動する
            iBefore = iBefore - 1
        Loop
        
        '// 挿入個所に事前に取得した値を格納
        a_Ar(iBefore + 1) = temp
    Next
End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

'// 指定フォルダ配下のサブフォルダとファイルのリストを配列に格納

Sub SearchAllDirFile(a_sFolder, a_ArPath())

Dim oFso As New FileSystemObject

Dim oFolder As Folder

Dim oSubFolder As Folder

Dim oFile As File

Dim arPath()

Dim i

Dim sFile

Dim sFolder

'// フォルダがない場合

If (oFso.FolderExists(a_sFolder) = False) Then

Exit Sub

End If

'// 指定フォルダのFolderオブジェクト取得

Set oFolder = oFso.GetFolder(a_sFolder)

'// 指定フォルダ配下にファイルが存在する場合

If (oFolder.Files.Count > 0) Then

'// パス配列の領域をファイル数で初期化

ReDim arPath(oFolder.Files.Count - 1)

i = 0

'// 指定フォルダ内のファイルを取得

For Each oFile In oFolder.Files

arPath(i) = oFile.Path

i = i + 1

'// 挿入ソートで整列

Call insertsortAsc(arPath)

'// ファイル数ループ

For Each sFile In arPath

'// 配列が初期化状態ではない場合

If (IsEmpty(a_ArPath(0)) = False) Then

'// 配列領域を拡張

ReDim Preserve a_ArPath(UBound(a_ArPath) + 1)

End If

'// ファイルパスを登録

a_ArPath(UBound(a_ArPath)) = sFile

End If

'// パス配列をクリア

Erase arPath

'// 指定フォルダ配下にサブフォルダが存在する場合

If (oFolder.SubFolders.Count > 0) Then

'// パス配列の領域をサブフォルダの数で初期化

ReDim arPath(oFolder.SubFolders.Count - 1)

i = 0

'// 指定フォルダ内のサブフォルダを取得

For Each oSubFolder In oFolder.SubFolders

arPath(i) = oSubFolder.Path

i = i + 1

'// 挿入ソートで整列

Call insertsortAsc(arPath)

'// サブフォルダ数ループ

For Each sFolder In arPath

'// 配列が初期化状態ではない場合

If (IsEmpty(a_ArPath(0)) = False) Then

'// 配列領域を拡張

ReDim Preserve a_ArPath(UBound(a_ArPath) + 1)

End If

'// フォルダパスを登録

a_ArPath(UBound(a_ArPath)) = sFolder

'// 再帰呼び出し

Call SearchAllDirFile(sFolder, a_ArPath)

End If

End Sub

'// 挿入ソート（昇順）

Sub insertsortAsc(a_Ar())

Dim iNow '// ループカウンタ（現要素用）

Dim iBefore '// ループカウンタ（前要素用）

Dim temp '// 一時格納領域

Dim iArrayCount '// 配列要素数

'// 配列の要素数を取得

iArrayCount = UBound(a_Ar)

'// 配列を２番目の要素から最後までループ

For iNow = 1 To iArrayCount

'// 配列の要素を一時格納

temp = a_Ar(iNow)

'// 前要素を取得

iBefore = iNow - 1

'// 前要素から先頭に向かってループ

'// 配列要素外の場合

If (iBefore < 0) Then

Exit Do

End If

'// 入れ替える必要がない場合

If (a_Ar(iBefore) <= temp) Then

Exit Do

End If

'// 配列の前後を入れ替える

a_Ar(iBefore + 1) = a_Ar(iBefore)

'// 前要素を先頭側に移動する

iBefore = iBefore - 1

Loop

'// 挿入個所に事前に取得した値を格納

a_Ar(iBefore + 1) = temp

End Sub

ADODBでのソートをお勧めしない理由

上のコードでは名前順のソートを行うために挿入ソートを利用していますが、ADODB.RecordSetクラスを利用するとデータベースのSQLのORDER BYのソート指定のような書き方をすることが可能です。

ただ、この方法はあまりお勧めしません。

理由は、ADODB自体があまり一般的でなくコードがマニアックなものになり保守性が悪いことと、いろんな条件のソートに柔軟に対応しにくいためです。SQLをご存じない方は苦労するかもしれません。

できるだけ多くの人に理解してもらえればと思い、挿入ソートでの方法にしています。

使い方

このようなフォルダ構成で、赤枠部分の一覧を取得したいとします。

その場合は以下のように7行目の１つ目の引数にパスを指定し、２つ目の引数に動的配列を指定します。

Sub SearchAllDirFileTest()
    Dim ar()
    Dim i
    
    ReDim ar(0)
    
    Call SearchAllDirFile("C:\web\test\test\", ar)
    
    For Each i In ar
        Debug.Print i
    Next
End Sub

Sub SearchAllDirFileTest()

Dim ar()

Dim i

ReDim ar(0)

Call SearchAllDirFile("C:\web\test\test\", ar)

For Each i In ar

Debug.Print i

End Sub

実行結果は以下のようになります。

C:\web\test\test\1.txt
C:\web\test\test\a.txt
C:\web\test\test\b.txt
C:\web\test\test\c
C:\web\test\test\d1
C:\web\test\test\d1\1.txt
C:\web\test\test\d1\a.txt
C:\web\test\test\d2

C:\web\test\test\1.txt

C:\web\test\test\a.txt

C:\web\test\test\b.txt

C:\web\test\test\c

C:\web\test\test\d1

C:\web\test\test\d1\1.txt

C:\web\test\test\d1\a.txt

C:\web\test\test\d2

フォルダとファイルの出力順を入れ替えたい場合

上のコードではフォルダ内にあるサブフォルダとファイルの両方がある場合は、先にファイルを出力していますが、フォルダを先に出力したい場合は、上のコードの20行目から46行目のファイル処理部分と、51行目から80行目のフォルダ処理部分の位置を入れ替えてください。

指定フォルダ配下をFileSystemObjectで取得する、けどソートは？

事前設定

指定フォルダ内のフォルダとファイルの一覧を取得するマクロ

ADODBでのソートをお勧めしない理由

使い方

フォルダとファイルの出力順を入れ替えたい場合

関連記事