全サブフォルダのファイルの取得

ちょっと前にやったことがあるので参考になれば・・・。

Private Sub GetFileCollection(ByRef sDirName As String, ByRef sFileCol As Collection)
　　Dim FSysObj As Scripting.FileSystemObject
　　Dim aFolder As Scripting.Folder
　　Dim ChildFolder As Scripting.Folder
　　Dim aFile As Scripting.File
　　Dim i As Long

　　On Error GoTo EXCEPTION_SECTION

　　Set FSysObj = New Scripting.FileSystemObject
　　Set aFolder = FSysObj.GetFolder(sDirName)
　　If (aFolder.Attributes And System) = System Then
　　　　Exit Sub
　　End If

　　For Each aFile In aFolder.Files
　　　　sFileCol.Add aFile.Path
　　Next aFile

　　If aFolder.SubFolders.Count > 0 Then
　　　　For Each ChildFolder In aFolder.SubFolders
　　　　　　Call GetFileCollection(ChildFolder.Path, sFileCol)
　　　　Next ChildFolder
　　End If

　　Exit Sub

EXCEPTION_SECTION:
　　MsgBox "[" & Err.Number & "]" & Err.Description, vbExclamation + vbOKOnly, "エラー"
　　Exit Sub

End Sub

投稿日時 - 2001-05-22 09:41:10