VBAを使用して複数のファイルを連続処理する際のファイルパスの取得方法

はじめに

Excel VBAで複数のファイルを連続処理するにはFileSystemObjectやDir関数を使うとおもいます。
別の方法として、DOSコマンドのDIRを組み合わせて利用する方法も考えられます。

FileSystemObject
Dir関数
DOSコマンドのDIR

どれが一番早いのか動作速度の比較を行ってみました。

FileSystemObjectを使用する場合

Function GetFileListUseFSO(ByVal TargetPath As String) As Variant
    Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject")
    Dim result() As String
    Dim i As Long
    Dim FilePath As Variant
    Dim ArrayList As New Collection
    If FSO.FolderExists(TargetPath) Then
        For Each FilePath In FSO.GetFolder(TargetPath).Files
            ArrayList.Add FilePath.Path
        Next
        ReDim result(1 To ArrayList.Count) As String
        For i = 1 To ArrayList.Count
            result(i) = ArrayList.Item(i)
        Next
        GetFileListUseFSO = result
    Else
        GetFileListUseFSO = Array()
    End If
End Function

この関数は、一時的にコレクションに格納された後、それを配列に変換して戻り値としています。経験上、フォルダ内のファイルが少ない場合には問題ありませんが、数百や数千のファイルパスを取得する場合には処理速度が低下する傾向があります。

Dir関数のみ使用

Dir関数はファイル名しか返ってこないので、取得元パスとつなげてフルパス名を作っています。

Function GetFileListUseDir(ByVal TargetPath As String) As Variant
    Dim result() As String
    Dim i As Long
    Dim FileName As String
    Dim ArrayList As New Collection
    FileName = Dir(TargetPath & "\*.*")
    If Not FileName = "" Then
        Do
            ArrayList.Add TargetPath & "\" & FileName
            FileName = Dir()
        Loop Until FileName = ""
        ReDim result(1 To ArrayList.Count) As String
        For i = 1 To ArrayList.Count
            result(i) = ArrayList.Item(i)
        Next
        GetFileListUseDir = result
    Else
        GetFileListUseDir = Array()
    End If
End Function

FileSystemObjectとDOSコマンドを併用

DIRコマンドの出力を一時的なファイルに書き込み、その結果を読み込んで配列に格納し、それを返す方法を使用しています。なお、CLIPを利用してクリップボード経由にする方法もありますが、今回は割愛します。
こちらもファイル名しか取得できないので、取得元パスとつなげてフルパス名を作っています。

Function GetFileListUseDOS(ByVal TargetPath As String) As Variant
    Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject")
    Dim WSH As Object: Set WSH = CreateObject("WScript.Shell")
    Dim result() As String
    Dim FileName As Variant
    Dim FilePath As Variant
    Dim ArrayList As Variant
    Dim i As Long
    If FSO.FolderExists(TargetPath) Then
        Do
            FilePath = Environ("TEMP") & "\" & FSO.GetTempName
        Loop Until Dir(FilePath) = ""
        WSH.Run "%ComSpec% /C DIR /B /A:A """ & TargetPath & """>""" & FilePath & """", 0, True
        With FSO.OpenTextFile(FilePath)
            ArrayList = Split(.Readall, vbCrLf)
            .Close
        End With
        If FSO.FileExists(FilePath) Then
            FSO.DeleteFile FilePath
        End If
        Dim FileCollection As New Collection
        For Each FileName In ArrayList
            If Not FileName = "" Then
                FileCollection.Add TargetPath & "\" & FileName
            End If
        Next
        ReDim result(1 To FileCollection.Count) As String
        For i = 1 To FileCollection.Count
            result(i) = FileCollection.Item(i)
        Next
        GetFileListUseDOS = result
    Else
        GetFileListUseDOS = Array()
    End If
End Function

この方法のメリットは、DIRコマンドのオプションに /S を追加すると、フルパス名およびサブフォルダまでのフルパスを取得一気に取得できる点です。
（「/S」を使用する場合は、パスの格納方法を修正する必要があります）

実行結果の比較

ダミーファイル１万件のファイルリスト作成を行い、その結果を比較しました。

結果として、Dir 関数が最速であり、一方で、FSO が最も遅かったことが分かりました。
DOS の遅延は、コマンドの実行やテキストファイルの読み込みに起因する可能性があります。
VBAのファイルリストの作成においては、Dir 関数の利用が最も効率的であると思います。

おまけ

Dir関数でサブフォルダを含めた再帰処理可能なファイルリスト取得する Function

Function GetFolderFiles(ByVal TargetFolder As String, _
    Optional ByVal IncludesSubDirectory As Boolean = False, _
    Optional ByRef FileList As Variant = Empty, _
    Optional ByVal isChild As Boolean = False) As Variant
    Dim FileName As String
    Dim FilePath As String
    Dim SubFolders As New Collection
    Dim Folder As Variant
    
    'ファイルリストが空であれば初期化
    If IsEmpty(FileList) Then
        FileList = Array()
    End If
    
    FileName = Dir(TargetFolder & "\*.*", vbDirectory)
    Do Until FileName = ""
        FilePath = TargetFolder & "\" & FileName
        '"."や".."の場合はスキップ
        If FileName <> "." And FileName <> ".." Then
            If GetAttr(FilePath) = vbDirectory Then
                SubFolders.Add FilePath
            Else
                ReDim Preserve FileList(UBound(FileList) + 1)
                FileList(UBound(FileList)) = FilePath
            End If
        End If
        FileName = Dir()
    Loop
    
    'サブディレクトリも含める場合は再帰処理
    If IncludesSubDirectory Then
        For Each Folder In SubFolders
            Call GetFolderFiles(Folder, IncludesSubDirectory, FileList, True)
        Next
    End If
    
    'isChildがFalseの場合にのみファイルリストを返します
    If Not isChild Then
        GetFolderFiles = FileList
    End If
    
End Function

' 使い方
Dim ArrayList As Varianrt
' 指定フォルダのみファイルリストを取得する場合
ArrayList = GetFolderFiles("C:\WorkDir")

' 指定フォルダのみサブフォルダも含めファイルリストを取得する場合
ArrayList = GetFolderFiles("C:\WorkDir", True)