Folder and File list count help

[Eisasuarez]

Hi all - hope you are all good

Im hoping you can please help me with this. I believe this code lists all the file paths, name, subfolder files, size etc within the main folder

Can you please help me amend this code so that i can seperate and add the folder name?

I also write another sub that lists each folder and gives me a count of how many folders and files there are and also the count of subfolders there are and how many files there are

I guess i can use this code and need to amend it

Can you please help me - thank you

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
   
    Application.ScreenUpdating = False
   
    'Assign the top folder to a variable
    FolderPath = "S:\CR\Resource Planning\"
    
   'With Sheet1
     
    'Insert the headers for Columns A through F
    Range("A1").Value = "File Path"
    Range("B1").Value = "File Name"
    Range("C1").Value = "File Size"
    Range("D1").Value = "Date Created"
    Range("E1").Value = "Date Last Accessed"
  
   
   'End With
   
    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
   
    'Get the top folder
    Set objTopFolder = objFSO.GetFolder(FolderPath)
   
    'Call the RecursiveFolder routine
    Call RecursiveFolder(objTopFolder, True)
   
    'Change the width of the columns to achieve the best fit
    Columns.AutoFit
       
        Application.ScreenUpdating = True
       
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, "C").End(xlUp).Row + 1
   
    'Loop through each file in the folder
    For Each objFile In objFolder.Files
       If Not objFile.Attributes And 2 Then
            Cells(NextRow, "A").Value = objFile.Path
            Cells(NextRow, "B").Value = objFile.Name
            Cells(NextRow, "C").Value = objFile.Size / 1024
            Cells(NextRow, "D").Value = objFile.DateCreated
            Cells(NextRow, "E").Value = objFile.DateLastAccessed
            Cells(NextRow, "F").Value = objFile.DateLastModified
   
            NextRow = NextRow + 1
        End If
    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
 
[/Codw]

 

[Eisasuarez]

Any luck please