View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Rob van Gelder[_4_] Rob van Gelder[_4_] is offline
external usenet poster
 
Posts: 1,236
Default 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/