VBA to list folders, sub folders AND files name

[wilsonlow]

Hello, I'm in the process of cleaning up a shared drive. The code I found online only list out all the FILE. I wanted the VBA to also list the FOLDER and SUB-FOLDER name. Can this be done? Any help is appreciated.

code below:

'Force the explicit delcaration of variablesOption Explicit


Sub ListFiles()


    'Set a reference to Microsoft Scripting Runtime by using
    'Tools > References in the Visual Basic Editor (Alt+F11)
    
    'Declare the variables
    Dim objFSO As Scripting.FileSystemObject
    Dim objTopFolder As Scripting.Folder
    Dim strTopFolderName As String
    
    'Insert the headers for Columns A through F
    Range("A1").Value = "File Name"
    Range("B1").Value = "File Size"
    Range("C1").Value = "File Type"
    Range("D1").Value = "Date Created"
    Range("E1").Value = "Date Last Accessed"
    Range("F1").Value = "Date Last Modified"
    Range("G1").Value = "File Path"
    
    'Assign the top folder to a variable
    strTopFolderName = "C:\User\Test"
    
    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    'Get the top folder
    Set objTopFolder = objFSO.GetFolder(strTopFolderName)
    
    'Call the RecursiveFolder routine
    Call RecursiveFolder(objTopFolder, True)
    
    'Change the width of the columns to achieve the best fit
    Columns.AutoFit
    
End Sub


Sub RecursiveFolder(objFolder As Scripting.Folder, _
    IncludeSubFolders As Boolean)


    'Declare the variables
    Dim objFile As Scripting.File
    Dim objSubFolder As Scripting.Folder
    Dim NextRow As Long
    
    'Find the next available row
    NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    'Loop through each file in the folder
    For Each objFile In objFolder.Files
        Cells(NextRow, "A").Value = objFile.Name
        Cells(NextRow, "B").Value = objFile.Size
        Cells(NextRow, "C").Value = objFile.Type
        Cells(NextRow, "D").Value = objFile.DateCreated
        Cells(NextRow, "E").Value = objFile.DateLastAccessed
        Cells(NextRow, "F").Value = objFile.DateLastModified
        Cells(NextRow, "G").Value = objFile.Path
        NextRow = NextRow + 1
    Next objFile
    
    'Loop through files in the subfolders
    If IncludeSubFolders Then
        For Each objSubFolder In objFolder.SubFolders
            Call RecursiveFolder(objSubFolder, True)
        Next objSubFolder
    End If
    
End Sub

 

[Fennek]

Hi,

an easy way is in the cmd-window:

dir /b /s > c:\temp\myList.txt

regards

 

[wilsonlow]

Hi Fennek,

Can you elaborate more a little bit? Is that code supposed to be typed at the CMD on window launch? Do I type in my drive path or type in what you typed which is c:\temp\myList.txt ?

Is there a way to extract the list of folders, sub-folders and file into excel instead of using CMD?

Thanks a lot for your assistance.

 

[John_w]

Open a command prompt (window) and type that command. It does a directory listing of the current directory and puts the files into the text file
c:\temp\myList.txt which you can import into Excel. To list files from a starting drive and folder path:

dir C:\my\folder\path\ /b /s > c:\temp\myList.txt

To do the same thing in VBA and put the files list into the active sheet:

Public Sub Dir_List()

    Dim fileSpec As String, files As Variant
    
    fileSpec = "C:\my\folder\path\"    'CHANGE AS NEEDED
    
    files = Split(CreateObject("wscript.shell").Exec("cmd /c dir """ & fileSpec & """ /b/s").StdOut.ReadAll, vbCrLf)
    ActiveSheet.Cells.ClearContents
    ActiveSheet.Range("A1").Resize(UBound(files)).Value = Application.WorksheetFunction.Transpose(files)

End Sub