Browse DevX
Sign up for e-mail newsletters from DevX

Tip of the Day
Language: Visual Basic
Expertise: Intermediate
Aug 1, 1997



Building the Right Environment to Support AI, Machine Learning and Deep Learning

Get all Matching Files in a Directory Structure

Because this code doesn't use an API, you can easily port it between 16- and 32- bit applications. The DirWalk procedure lets you search an entire directory structure starting at whatever you specify as the argument:
ReDim sArray(0) As String
Call DirWalk("OLE*.DLL", "C:\", sArray)
The procedure accepts wildcards in the first argument, which is the search pattern for file names. You can even specify multiple search patterns using the semicolon as a separator, as in "OLE*.DLL; *.TLB." The second argument is the location of where to start, and the third argument is an array of strings. The procedure recursively goes to the deepest level in the directory structure and gets all the matching file names with full path in the array sArray. This array is ReDimed from the function and has as many members as matches found. To use DirWalk, put two extra controls, FileListBox and DirListBox, on the form. This procedure assumes it's on a form on which there are two controls: FileListBox with name File1, and DirListBox with name Dir1. Keep the controls invisible to improve the speed of the search. Putting these additional controls on a form doesn't cause any overhead because they're part of a basic library of controls for VB:
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 & "\"
        Dir1.Path = CurrDir
End If
For i = 0 To Dir1.ListCount
        If Dir1.List(i) <> "" Then
                Call DirWalk(sPattern, _
                        Dir1.List(i), sFound())
                If Right$(Dir1.Path, 1) = "\" _
                        sCurrPath = Left(Dir1.Path, _
                                Len(Dir1.Path) - 1)
                        sCurrPath = Dir1.Path
                End If
                File1.Path = sCurrPath
                File1.Pattern = sPattern
                If File1.ListCount > 0 Then 
                        'matching files found in the 
                        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
                Dir1.Path = Mid(Dir1.Path, 1, _
        End If
Next i
End Sub
Atul Ganatra
Comment and Contribute






(Maximum characters: 1200). You have 1200 characters left.



Thanks for your registration, follow us on our social networks to keep up-to-date