Macro to enumerate subdirs and files in a directory!
Is there anyone know a Macro to enumerate subdirs and files in a
directory! Thanks, --- Message posted from http://www.ExcelForum.com/ |
Macro to enumerate subdirs and files in a directory!
This is not my code. I cannot remeber who authored it - PSC maybe.
Private Sub Path() On Error GoTo handle Dim fso, fs, f, x Set fso = CreateObject("scripting.filesystemobject") 'create filesystemobject Set fs = fso.getfolder("c:\") 'gets a hanlde on th path ' cange as appropriate Set f = fs.subfolders 'gets a list of al the folders in the path Set x = fs.files 'gets a list of al the files in the path For Each w In f 'for..next loop 'w this point is the folders in the directory 'for every folder in the list, add it to the subfolder listbox ' your code here Next 'loop For Each v In x 'v lists the files in each folder ' your code here Next Exit Sub handle: msg = MsgBox("An error has been found. Make sure that the driv and path exist.", vbCritical, "Error") End Su -- Message posted from http://www.ExcelForum.com |
Macro to enumerate subdirs and files in a directory!
Bookworm98,
Here's one I put together a while ago - it could do with some optimising, but I was using it for a once-off task so wasn't fussy. Sub test() Dim arr() As String, i As Long arr = RecursiveDir("C:\WINDOWS\") For i = LBound(arr) To UBound(arr) Debug.Print arr(i) Next End Sub Function RecursiveDir(Path As String, Optional Attributes As VbFileAttribute) As String() Dim strPath As String, strResult As String, i As Long, j As Long, k As Long Dim arrPath() As String, arrFile() As String, arrTemp() As String On Error Resume Next strPath = Path If Right(strPath, 1) < Application.PathSeparator Then strPath = strPath & Application.PathSeparator strResult = Dir(strPath, vbDirectory Or Attributes) Do Until strResult = "" If GetAttr(strPath & strResult) And vbDirectory Then If Not (strResult = "." Or strResult = "..") Then i = UBound(arrPath) + 1 If CBool(Err.Number) Then Err.Clear: i = 0 End If ReDim Preserve arrPath(i) arrPath(i) = strPath & strResult & Application.PathSeparator End If Else i = UBound(arrFile) + 1 If CBool(Err.Number) Then Err.Clear: i = 0 End If ReDim Preserve arrFile(i) arrFile(i) = strPath & strResult End If strResult = Dir Loop i = LBound(arrPath) If Not CBool(Err.Number) Then For i = LBound(arrPath) To UBound(arrPath) arrTemp = RecursiveDir(arrPath(i), Attributes) j = LBound(arrTemp) If Not CBool(Err.Number) Then For j = LBound(arrTemp) To UBound(arrTemp) k = UBound(arrFile) + 1 If CBool(Err.Number) Then Err.Clear: k = 0 End If ReDim Preserve arrFile(k) arrFile(k) = arrTemp(j) Next Else Err.Clear End If Next Else Err.Clear End If arrTemp = arrPath i = LBound(arrFile) If Not CBool(Err.Number) Then For i = LBound(arrFile) To UBound(arrFile) j = UBound(arrTemp) + 1 If CBool(Err.Number) Then Err.Clear: j = 0 End If ReDim Preserve arrTemp(j) arrTemp(j) = arrFile(i) Next Else Err.Clear End If RecursiveDir = arrTemp End Function Rob "bookworm98 " wrote in message ... Is there anyone know a Macro to enumerate subdirs and files in a directory! Thanks, --- Message posted from http://www.ExcelForum.com/ |
Macro to enumerate subdirs and files in a directory!
|
All times are GMT +1. The time now is 09:19 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com