Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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/ |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
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/ |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to enumerate subdirs and files in a directory!
|
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Open files in the same directory | Excel Discussion (Misc queries) | |||
Macro - Open all word files in a directory | Excel Worksheet Functions | |||
Files in a directory? | Excel Discussion (Misc queries) | |||
Check if directory empty OR no of files in directory. | Excel Programming | |||
run macro for all files in the directory | Excel Programming |