CODEWITHSUNDEEP
vbaexceldirectory
Coding Novice
Coding Novice

Reputation: 447

Modify Existing Code that Lists Folders/Sub-Folders to Include File Names

I have a code that will completely list the entirety of all of the folders and sub-folders within a given path. I foolishly ran the code on a folder containing tens of thousands of sub-folders, so while I wait for that to finish I would like to start thinking about the next step.

I need the code to also go one step deeper into the rabbit hole and pick up file names. Here is the code:

Option Explicit 

    Dim i As Long, j As Long 
    Dim searchfolders As Variant 
    Dim FileSystemObject 

    Sub ListOfFolders() 
        Dim LookInTheFolder As String 

        i = 1 
        LookInTheFolder = "C:\" ' As you know; you should modificate this row.
        Set FileSystemObject = CreateObject("Scripting.FileSystemObject") 
        For Each searchfolders In FileSystemObject.GetFolder(LookInTheFolder).SubFolders 
            Cells(i, 1) = searchfolders 
            i = i + 1 
            SearchWithin searchfolders 
        Next searchfolders 

    End Sub 

Sub SearchWithin(searchfolders) 
        On Error GoTo exits 
    For Each searchfolders In FileSystemObject.GetFolder(searchfolders).SubFolders 
        j = UBound(Split(searchfolders, "\")) 
        Cells(i, j) = searchfolders 
        i = i + 1 
        SearchWithin searchfolders 
        Next searchfolders 
        exits: 
End Sub

The code outputts into a tree like chart and I would like to extend to the last branch including file names.

Please help! Thank you.

Upvotes: 1

Views: 82

Answers (1)

Constuntine
Constuntine

Reputation: 508

I have had to do this many times, and many times over I've used this same function.

Function GetFilenameFromPath(ByVal strPath As String) As String
' Returns the rightmost characters of a string upto but not including the rightmost '\'

    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
        GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
    End If
End Function

Just pass the entire path of the file into the function. And it will return the file name.

Another option is this function.

Public Function RecursiveDir(colFiles As Collection, _
                          ByVal strFolder As String, _
                          strFileSpec As String, _
                          bIncludeSubfolders As Boolean)

 Dim strTemp As String
 Dim colFolders As New Collection
 Dim vFolderName As Variant

'Add files in strFolder matching strFileSpec to colFiles
 strFolder = TrailingSlash(strFolder)
 strTemp = Dir(strFolder & strFileSpec)
 Do While strTemp <> vbNullString
     colFiles.Add strFolder & strTemp
     strTemp = Dir
 Loop

'Fill colFolders with list of subdirectories of strFolder
 If bIncludeSubfolders Then
     strTemp = Dir(strFolder, vbDirectory)
     Do While strTemp <> vbNullString
         If (strTemp <> ".") And (strTemp <> "..") Then
             If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
                 colFolders.Add strTemp
             End If
         End If
         strTemp = Dir
     Loop

'Call RecursiveDir for each subfolder in colFolders
     For Each vFolderName In colFolders
         Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True)
     Next vFolderName
 End If

'Garbage collection
 Set colFolders = Nothing

End Function

This function will populate a collection of every file name in a given directory. And if you want you can set the bIncludeSubfolders to true, and it will recursively search all subfolders within this directory. To use this function, you need the following:

Dim colFiles As New Collection ' The collection of files
Dim Path As String ' The parent Directory you want to search
Dim subFold As Boolean ' Search sub folders, yes or no?
Dim FileExt As String ' File extension type to search for

Then just set FileExt = "*.*" Which will find every file with every file extension. Hopefully this helps a little more.

Upvotes: 2

Related Questions