Sub getDirList(strSartDir As String) Dim FilesList As Variant, i As Long FilesList = DirList(strSartDir) For i = LBound(FilesList) To UBound(FilesList) Debug.Print FilesList(i) Next End Sub
Public Function DirList(StartDir As String) As Variant Dim FileName As String, sDir As String Dim arrFolders() As String, arrDirList() As Variant, arrSubDirList As Variant Dim i As Long, j As Long, k As Long sDir = IIf(Right(StartDir, 1) = "", StartDir, StartDir & "") i = 0 FileName = Dir(sDir) Do While FileName <> "" If FileName <> "." And FileName <> ".." Then If (GetAttr(sDir & FileName) Or vbDirectory) = vbDirectory Then Else ReDim Preserve arrDirList(i) arrDirList(i) = sDir & FileName End If End If FileName = Dir i = i + 1 Loop j = 0 FileName = Dir(sDir, vbDirectory) Do While FileName <> "" If FileName <> "." And FileName <> ".." Then If (GetAttr(sDir & FileName) And vbDirectory) = vbDirectory Then ReDim Preserve arrFolders(j) arrFolders(j) = FileName j = j + 1 End If End If FileName = Dir Loop If j > 0 Then For j = LBound(arrFolders) To UBound(arrFolders) If Dir(sDir & arrFolders(j) & "") > "" Then arrSubDirList = DirList(sDir & arrFolders(j) & "") For k = LBound(arrSubDirList) To UBound(arrSubDirList) ReDim Preserve arrDirList(i) arrDirList(i) = arrSubDirList(k) i = i + 1 Next k End If Next j End If DirList = arrDirList End Function