Find files in subdirectory of a subdirectory

[Maverick44]

I used code from Microsoft Support (Method 2) to search through subdirectories and find a specific file. It works if I make the path specific enough so that my file is in the subdirectory of that path. However, I would like to generalize my search a bit more and name my path as a folder that is two tiers above the folder which contains the desired file. Below is the code

Function FindFiles(path As String, SearchStr As String, _
       FileCount As Integer, DirCount As Integer)
      Dim FileName As String   ' Walking filename variable.
      Dim DirName As String    ' SubDirectory Name.
      Dim dirNames() As String ' Buffer for directory name entries.
      Dim nDir As Integer      ' Number of directories in this path.
      Dim i As Integer         ' For-loop counter.

      On Error GoTo sysFileERR
      If Right(path, 1) <> "\" Then path = path & "\"
      ' Search for subdirectories.
      nDir = 0
      ReDim dirNames(nDir)
      DirName = Dir(path, vbDirectory Or vbHidden Or vbArchive Or vbReadOnly _
Or vbSystem)  ' Even if hidden, and so on.
      Do While Len(DirName) > 0
         ' Ignore the current and encompassing directories.
         If (DirName <> ".") And (DirName <> "..") Then
            ' Check for directory with bitwise comparison.
            If GetAttr(path & DirName) And vbDirectory Then
               dirNames(nDir) = DirName
               DirCount = DirCount + 1
               nDir = nDir + 1
               ReDim Preserve dirNames(nDir)
               'List2.AddItem path & DirName ' Uncomment to list
            End If                           ' directories.
   sysFileERRCont:
         End If
         DirName = Dir()  ' Get next subdirectory.
      Loop

      ' Search through this directory and sum file sizes.
      FileName = Dir(path & SearchStr, vbNormal Or vbHidden Or vbSystem _
      Or vbReadOnly Or vbArchive)
      While Len(FileName) <> 0
         FindFiles = FindFiles + FileLen(path & FileName)
         FileCount = FileCount + 1
         ' Load List box
         List2.AddItem path & FileName & vbTab & _
            FileDateTime(path & FileName)   ' Include Modified Date
         FileName = Dir()  ' Get next file.
      Wend

      ' If there are sub-directories..
      If nDir > 0 Then
         ' Recursively walk into them
         For i = 0 To nDir - 1
           FindFiles = FindFiles + FindFiles(path & dirNames(i) & "\", _
            SearchStr, FileCount, DirCount)
         Next i
      End If

   AbortFunction:
      Exit Function
   sysFileERR:
      If Right(DirName, 4) = ".sys" Then
        Resume sysFileERRCont ' Known issue with pagefile.sys
      Else
        MsgBox "Error: " & Err.Number & " - " & Err.Description, , _
         "Unexpected Error"
        Resume AbortFunction
      End If
      End Function

 

[John_w]

Do you need those parts of the code which add the files to a list box and sum the file sizes? Or just the ability to find a file in a folder and its subfolders?

You might consider method 3 (FileSystemObject) http://support.microsoft.com/kb/185601/EN-US, which should be much simpler to implement.

 

[Maverick44]

I would simply like to find the files within the subfolders of the subfolders and open those files. I do not need to sum their sizes. While the Method 3 code is simpler, I'm still stuck on how to execute this.

 

[John_w]

Try this - using the FSO method - to get started. Change the start folder and file name to suit.

Dim fso As New FileSystemObject


Public Sub Test()
    
    Dim startFolder As String, findFileName As String, maxSubfolderLevels As Integer
    Dim foundInFolder As String
    
    startFolder = "C:\path\to\parent\folder"
    findFileName = "fileToFind.xyz"
    maxSubfolderLevels = 2
    
    foundInFolder = FindFile(startFolder, findFileName, maxSubfolderLevels)
    If foundInFolder <> "" Then
        MsgBox findFileName & " found in " & foundInFolder
    Else
        MsgBox findFileName & " not found"
    End If
    
End Sub


Private Function FindFile(searchFolder As String, fileName As String, ByVal folderLevel As Integer) As String
   
    Dim thisFolder As folder, subfolder As folder
    
    FindFile = ""
    Set thisFolder = fso.GetFolder(searchFolder)
    Debug.Print fso.BuildPath(thisFolder.Path, fileName)
    If fso.FileExists(fso.BuildPath(thisFolder.Path, fileName)) Then
        FindFile = thisFolder.Path
    ElseIf folderLevel > 0 Then
        For Each subfolder In thisFolder.SubFolders
            FindFile = FindFile(subfolder.Path, fileName, folderLevel - 1)
            If FindFile <> "" Then Exit For
        Next
    End If
    
End Function

 

[Maverick44]

This code works great for finding one file in a subdirectory of a subdirectory. Thank you so much! I would actually like to find a list of files all starting with the same string. In the Method 3 code, I was able to simply search "sameStringName*" to find all files with that string in the beginning. I think this is because they utilized the Dir() function. Is there any way to utilize that function in this code so that I can populate a list of files containing the same string?

 

[John_w]

Well your posts are ambiguous ("find a specific file", "find files") so I answered based on one interpretation of your request, and you haven't answered my question about the list box.

Try this instead. FindFiles() returns the number of matching files and a string array of matching file names, which you can use to populate a list box, Excel cells, etc, as shown by the Test procedure.

See the VBA help on the Like operator for allowable wildcard characters.

Option Explicit


Dim fso As New FileSystemObject


Public Sub Test()
    
    Dim startFolder As String, findFileName As String, maxSubfolderLevels As Integer
    Dim matchingFiles() As String, numFiles As Integer
    
    startFolder = "C:\path\to\parent\folder"
    findFileName = "wildcardFileName*"
    maxSubfolderLevels = 2
    
    numFiles = FindFiles(startFolder, findFileName, maxSubfolderLevels, matchingFiles)
    
    If numFiles > 0 Then
        MsgBox "Found " & numFiles & " files matching " & findFileName & " in " & startFolder & " and " & maxSubfolderLevels & " subfolder levels" & _
            vbCr & Join(matchingFiles, vbCr)
    Else
        MsgBox "Found no files matching " & findFileName & " in " & startFolder & " and " & maxSubfolderLevels & " subfolder levels"
    End If
    
End Sub


Private Function FindFiles(searchFolder As String, fileNamePattern As String, ByVal folderLevel As Integer, matchingFiles() As String) As Integer
   
    Dim thisFolder As Folder, Subfolder As Folder
    Dim thisFile As File
    Dim fileName As String
    Dim n As Integer
        
    FindFiles = 0
    
    Set thisFolder = fso.GetFolder(searchFolder)
    
    If InStr(fileNamePattern, "?") Or InStr(fileNamePattern, "*") Or InStr(fileNamePattern, "#") Or InStr(fileNamePattern, "[") Then
    
        'fileNamePattern contains wildcard characters ?, *, #, [], so we can use the Like operator to compare each file name in this folder
        
        For Each thisFile In thisFolder.Files
            If thisFile.Name Like fileNamePattern Then
                Debug.Print thisFile.Path
                FindFiles = FindFiles + 1
                n = GetUBound(matchingFiles) + 1
                ReDim Preserve matchingFiles(n)
                matchingFiles(n) = thisFile.Path
            End If
        Next
        
    Else
    
        'fileNamePattern doesn't contain wildcards, so we can use FileExists to find the specific file in this folder
        
        fileName = fso.BuildPath(thisFolder.Path, fileNamePattern)
        If fso.FileExists(fileName) Then
            Debug.Print fileName
            FindFiles = FindFiles + 1
            n = GetUBound(matchingFiles) + 1
            ReDim Preserve matchingFiles(n)
            matchingFiles(n) = fileName
        End If
        
    End If
    
    If folderLevel > 0 Then
    
        'Look in subfolders
        
        For Each Subfolder In thisFolder.SubFolders
            FindFiles = FindFiles + FindFiles(Subfolder.Path, fileNamePattern, folderLevel - 1, matchingFiles)
        Next
        
    End If

End Function


Private Function GetUBound(stringArray() As String) As Integer
    
    'Returns UBound of a string array, or -1 if the array has no elements
    
    On Error Resume Next
    GetUBound = UBound(stringArray)
    If Err <> 0 Then GetUBound = -1
    
End Function