|
ReDim sArray(0) As String
Call DirWalk("OLE*.DLL", "C:\", sArray) Sub DirWalk(ByVal sPattern As String, ByVal CurrDir As String, sFound() As String) Dim i As Integer Dim sCurrPath As String Dim sFile As String Dim ii As Integer Dim iFiles As Integer Dim iLen As Integer If Right$(CurrDir, 1) "\" Then Dir1.Path = CurrDir & "\" Else Dir1.Path = CurrDir End If For i = 0 To Dir1.ListCount If Dir1.List(i) "" Then DoEvents Call DirWalk(sPattern, Dir1.List(i), sFound) Else If Right$(Dir1.Path, 1) = "\" Then sCurrPath = Left(Dir1.Path, Len(Dir1.Path) - 1) Else sCurrPath = Dir1.Path End If File1.Path = sCurrPath File1.Pattern = sPattern If File1.ListCount > 0 Then 'matching files found in the directory For ii = 0 To File1.ListCount - 1 ReDim Preserve sFound(UBound(sFound) + 1) sFound(UBound(sFound) - 1) = sCurrPath & "\" & File1.List(ii) Next ii End If iLen = Len(Dir1.Path) Do While Mid(Dir1.Path, iLen, 1) "\" iLen = iLen - 1 Loop Dir1.Path = Mid(Dir1.Path, 1, iLen) End If Next i End Sub |