ファイルリスト・フォルダリスト取得
ファイルリストを取得する。
'依存ファンクション:GetSubFolders
Public Function GetFiles(ByVal path As String, ByVal findSubFolder As Boolean, ByRef mask() As String) As String()
    Dim fileCount As Long
    Dim files() As String

    ReDim files(128 - 1)

    Dim folders() As String

    If findSubFolder Then
        folders = GetSubFolders(path, True)
    Else
        ReDim folders(0)
        folders(0) = path
    End If

    Dim i As Long
    Dim file_ As String
    For i = 0 To UBound(folders)
        Dim fIdx As Long    '開始インデックス(フォルダ単位)
        fIdx = fileCount

        Dim fCnt As Long    'ファイル数(フォルダ単位)
        fCnt = 0

        Dim j As Long
        For j = 0 To UBound(mask)
            file_ = VBA.Dir(folders(i) & "\" & mask(j))
            Do While file_ <> ""

                '重複ファイル判定
                Dim existsFile_ As Boolean: existsFile_ = False
                Dim k As Long
                For k = fIdx To fIdx + fCnt - 1
                    If files(k) = folders(i) & "\" & file_ Then
                        existsFile_ = True
                        Exit For
                    End If
                Next

                If Not existsFile_ Then
                    If UBound(files) < fileCount Then
                        ReDim Preserve files(UBound(files) * 2 + 1)
                    End If
                    files(fileCount) = folders(i) & "\" & file_
                    fileCount = fileCount + 1
                    fCnt = fCnt + 1
                End If

                file_ = VBA.Dir()
            Loop
        Next
    Next

    If 0 < fileCount Then
        ReDim Preserve files(fileCount - 1)
    Else
        files = Split("")
    End If

    GetFiles = files
End Function
		
フォルダリストを取得する。
'依存ファンクション:GetSubFoldersRe
Public Function GetSubFolders(ByVal path As String, ByVal containsRoot As Boolean) As String()
    Dim folders() As String
    ReDim folders(128 - 1)

    Dim cnt As Long

    If containsRoot Then
        folders(0) = path
        cnt = 1
    End If

    Call GetSubFoldersRe(path, folders, cnt)

    ReDim Preserve folders(cnt - 1)

    GetSubFolders = folders
End Function

Private Function GetSubFoldersRe(ByVal path As String, ByRef folders() As String, ByRef cnt As Long) As Long
    Dim fso As FileSystemObject 'Microsoft Scripting Runtime
    Set fso = New FileSystemObject

    Dim subFolders As folders
    Set subFolders = fso.GetFolder(path).subFolders

    Dim fld As Folder
    For Each fld In subFolders
        cnt = cnt + 1

        If UBound(folders) < cnt - 1 Then
            ReDim Preserve folders((UBound(folders) + 1) * 2 - 1)
        End If

        folders(cnt - 1) = fld.path

        cnt = GetSubFoldersRe(fld.path, folders, cnt)
    Next

    GetSubFoldersRe = cnt
End Function
		

Index