☆参照に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 件のコメント:
コメントを投稿