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. TheDirWalk procedure lets you search an entire directory structure starting at whatever you specify as theargument:

 ReDim sArray(0) As StringCall DirWalk("OLE*.DLL", "C:", sArray)

The procedure accepts wildcards in the first argument, which is the search pattern for file names. You caneven specify multiple search patterns using the semicolon as a separator, as in “OLE*.DLL; *.TLB.” Thesecond 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 filenames with full path in the array sArray. This array is ReDimed from the function and has as many membersas matches found.To use DirWalk, put two extra controls, FileListBox and DirListBox, on the form. This procedure assumesit’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 formdoesn’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 IntegerDim sCurrPath As StringDim sFile As StringDim ii As IntegerDim iFiles As IntegerDim iLen As IntegerIf Right$(CurrDir, 1) <> "" Then        Dir1.Path = CurrDir & ""Else        Dir1.Path = CurrDirEnd IfFor 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 IfNext iEnd Sub
Share the Post:
Share on facebook
Share on twitter
Share on linkedin

Overview

Recent Articles: