2012年7月25日水曜日

再帰的(サブフォルダも含む)にあるディレクトリ配下のファイル一覧を取得、配列の結合(マージ)メッソドもセットで

バグがあったら、教えてくれるとありがたい
☆参照にscriptingは必要!☆
再帰的(サブフォルダも含む)にあるディレクトリ配下のファイル一覧を取得メッソド
Function ListUp(FolderSpec) As Variant

    Dim File_Collection As Object
    Dim File_List As Variant
    Dim Folder_Collection As Object
    Dim Folder_List As Variant
    Dim result As Variant
    Dim subResult As Variant
    Dim subResultAppend As Variant

    If Not CreateObject("Scripting.FileSystemObject").FolderExists(FolderSpec) Then
        ListUp = Empty
        Exit Function
    End If
    
    Set File_Collection = _
                     CreateObject("Scripting.FileSystemObject") _
                    .GetFolder(FolderSpec).Files
    

    For Each File_List In File_Collection
        push FolderSpec & "\" & File_List.Name, result
    Next
    
    Set Folder_Collection = _
                       CreateObject("Scripting.FileSystemObject") _
                      .GetFolder(FolderSpec).SubFolders
    
    For Each Folder_List In Folder_Collection
        subResultAppend = ListUp(FolderSpec & "\" & Folder_List.Name)
        subResult = ArrayMerge(subResultAppend, subResult, True)
    Next
    
    ListUp = ArrayMerge(subResult, result)
End Function
配列最後に要素を追加していくメッソド
'this is a function to push an element into an array
Public Function push(ByVal val As Variant, ByRef arr As Variant) As Integer
    If IsArray(arr) Then
        ReDim Preserve arr(UBound(arr) + 1)
    Else
        ReDim arr(0)
    End If
    arr(UBound(arr)) = val
    push = UBound(arr)
End Function
配列を結合するメソッド、追加(ダブリチェックなし)とマージ(ダブリチェックあり)モードあり、最後の引数は結語した後に、元配列を消す設定
Public Function ArrayMerge(ByRef sourceArray As Variant, ByRef destArray As Variant, Optional appendMode As Boolean = False, Optional KillSource As Boolean = False) As Variant
Dim sDic As New Scripting.Dictionary
Dim v As Variant
Dim tempArray As Variant
Dim idx As Long

'片方だけなら、片方を返す
If (Not IsArray(sourceArray)) And (Not IsArray(destArray)) Then
    ArrayMerge = Null
    Exit Function
ElseIf Not IsArray(sourceArray) Then
    ArrayMerge = destArray
    Exit Function
ElseIf Not IsArray(destArray) Then
    ArrayMerge = sourceArray
    Exit Function
End If

'ダブリチェックしない、ただ追加していくモード
If appendMode Then
    ReDim tempArray(UBound(sourceArray) + UBound(destArray) + 1)
    idx = 0
    For Each v In sourceArray
        tempArray(idx) = v
        idx = idx + 1
    Next
    For Each v In destArray
        tempArray(idx) = v
        idx = idx + 1
    Next
'ダブリチェックする、Mergeモード。ないものだけ追加していくモード
Else
    idx = 0
    For Each v In sourceArray
        sDic.Add v, idx
        idx = idx + 1
    Next
    
    For Each v In destArray
        If Not sDic.Exists(v) Then
            sDic.Add v, idx
            idx = idx + 1
        End If
    Next
    tempArray = sDic.Keys
End If
If KillSource = True Then Erase sourceArray
ArrayMerge = tempArray
End Function
使い方はこう、"c:\windows"みたいな深すぎフォルダーは使わないほうがいいね、timeoutっぽい
dim fileList as Variant
fileList = ListUp("c:\your_path")

0 件のコメント:

コメントを投稿