Adding a new field to the results of my "list the folders inside a specific folder" code

[scotthannaford1973]

I've created some code (thanks to Mr Excel) that will let a user create a list of all of the sub-folders (down three levels, I think) within a folder they specify. The end results look like this, but I'd like to add a new field that counts all of the files in each of the folders.

the two main bits of code are as below - can anyone please advise how I can add a new field to count the files?

Sub FolderNames()
Application.ScreenUpdating = False
Dim xPath As String
Dim xWs As Worksheet
Dim fso As Object, j As Long, folder1 As Object
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choose the folder"
.Show
End With
On Error Resume Next
xPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
Application.Sheets("Folders").Activate

Set xWs = Application.ActiveSheet
xWs.Cells(1, 1).Value = xPath
xWs.Cells(2, 1).Resize(1, 5).Value = Array("Path", "Dir", "Name", "Date Created", "Date Last Modified")
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder1 = fso.getFolder(xPath)
getSubFolder folder1
xWs.Cells(2, 1).Resize(1, 5).Interior.Color = 65535
xWs.Cells(2, 1).Resize(1, 5).EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub

-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Sub getSubFolder(ByRef prntfld As Object)
Dim SubFolder As Object
Dim subfld As Object
Dim xRow As Long
For Each SubFolder In prntfld.SubFolders
xRow = Range("A1").End(xlDown).Row + 1
Cells(xRow, 1).Resize(1, 5).Value = Array(SubFolder.Path, Left(SubFolder.Path, InStrRev(SubFolder.Path, "\")), SubFolder.Name, SubFolder.DateCreated, SubFolder.DateLastModified)
Next SubFolder
For Each subfld In prntfld.SubFolders
getSubFolder subfld
Next subfld

End Sub

 

[rollis13]

Have a try with these tweaks:

Option Explicit
Sub FolderNames()
    Dim xPath As String
    Dim xWs   As Worksheet
    Dim fso   As Object, j As Long, folder1 As Object
    Application.ScreenUpdating = False
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Choose the folder"
        .Show
    End With
    On Error Resume Next
    xPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
    Application.Sheets("Folders").Activate
    Set xWs = Application.ActiveSheet
    xWs.Cells(1, 1).Value = xPath
    xWs.Cells(2, 1).Resize(1, 6).Value = Array("Path", "Dir", "Name", "Date Created", "Date Last Modified", "N.Files") '<- changed adding column and title
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder1 = fso.getFolder(xPath)
    GetSubFolder folder1
    xWs.Cells(2, 1).Resize(1, 6).Interior.Color = 65535 '<- changed adding column
    xWs.Cells(2, 1).Resize(1, 6).EntireColumn.AutoFit '<- changed adding column
    Application.ScreenUpdating = True
    MsgBox "Done!"
End Sub

Sub GetSubFolder(ByRef PrntFld As Object)
    Dim SubFolder As Object
    Dim SubFld As Object
    Dim xRow  As Long
    Dim CntFiles As Long                          '<- added
    Dim strFile As String                         '<- added
    For Each SubFolder In PrntFld.SubFolders
        strFile = Dir(SubFolder & "\*.*")         '<- added loop to count all files in folders
        Do While strFile <> ""                    '<- added
            CntFiles = CntFiles + 1               '<- added
            strFile = Dir()                       '<- added
        Loop                                      '<- added
        xRow = Range("A1").End(xlDown).Row + 1
        Cells(xRow, 1).Resize(1, 6).Value = Array(SubFolder.Path, Left(SubFolder.Path, InStrRev(SubFolder.Path, "\")), SubFolder.Name, SubFolder.DateCreated, SubFolder.DateLastModified, CntFiles) '<- changed adding column and counter
        CntFiles = 0                              '<- added reset counter for next folder
    Next SubFolder
    For Each SubFld In PrntFld.SubFolders
        GetSubFolder SubFld
    Next SubFld
End Sub

 

[John_w]

list of all of the sub-folders (down three levels, I think) within a folder they specify. The end results look like this, but I'd like to add a new field that counts all of the files in each of the folders.

It goes down all levels. To include a files count of each subfolder:

        Cells(xRow, 1).Resize(1, 6).Value = Array(SubFolder.Path, Left(SubFolder.Path, InStrRev(SubFolder.Path, "\")), SubFolder.Name, SubFolder.DateCreated, SubFolder.DateLastModified, SubFolder.Files.Count)

and change all the other Resize(1, 5) to Resize(1, 6).