How to create list of folder and subfolder properties in excel

[JSH720]

I have several folders. for eac h, I need to list the memory used, the number of folders and numbers of files under each folder with its name) Just as if you had click proerties on each one. VBA for this? I have about 100 folders (not including subfolders) in each of 5 directories.......
thanks.

 

[Yongle]

Try this
- copy everything to a single standard module
- amend Const values for F1, F2, F3, F4 etc
- amend FoldersToSearch to reflect variables used , with a comma between each constant
- run TestListFolders

The macro creates a new workbook with
- a listing of the FoldersToSearch
- their sub-folders
- the attributes of each folder

Option Explicit

[B]Sub TestListFolders[/B]()
Dim Fldr As Variant
    Application.ScreenUpdating = False
        AddWorkBook
        For Each Fldr In Split(FoldersToSearch, ",")
            ListFolders CStr(Fldr), True
        Next
    Application.ScreenUpdating = True
End Sub

[B]Function FoldersToSearch[/B]() As String

Const F1 = "[COLOR=#ff0000]C:\TestArea[/COLOR]"
Const F2 = "[COLOR=#ff0000]C:\Program Files\internet explore[/COLOR][COLOR=#ff0000]r[/COLOR]"
Const F3 = [COLOR=#ff0000]"C:\Program Files\Mozilla Firefox[/COLOR]"
Const F4 = "[COLOR=#ff0000]C:\Users\yongle\Desktop[/COLOR]"
Const F5 = ""
Const F6 = ""
Dim FolderString As String
[COLOR=#000080]FoldersToSearch [/COLOR]= [COLOR=#ff0000]F1[/COLOR] & "," & [COLOR=#ff0000]F2[/COLOR] & "," & [COLOR=#ff0000]F3[/COLOR] & "," & [COLOR=#ff0000]F4[/COLOR]

End Function

[B]Sub AddWorkBook[/B]()
    Workbooks.Add
' add headers
    With Range("A1")
        .Formula = "Folder contents":   .Font.Bold = True: .Font.Size = 12
    End With
    With Range("A3:G3")
        .Value = Split("Folder Path,Folder Name,Size,Subfolders:,Files,Short Name,Short Path", ",")
        .Font.Bold = True
    End With
End Sub

[B]Sub ListFolders[/B](SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the folders in SourceFolder
' example: ListFolders "C:\", True
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim r As Long
    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
    On Error Resume Next    'line added for "Permission Denied" errors
    
    r = Range("A" & Rows.count).End(xlUp).Row + 1
    With SourceFolder       ' display folder properties
        Cells(r, 1).Resize(, 7) = Array(.Path, .Name, .Size, .SubFolders.count, .Files.count, .ShortName, .ShortPath)
    End With
    
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFolders SubFolder.Path, True
        Next SubFolder
        Set SubFolder = Nothing
    End If
    
    Columns("A:G").AutoFit
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Sub

Credit for the original code here:
'https://www.ozgrid.com/forum/forum/help-forums/excel-general/60566-list-folders-subfolders-from-directory

 

[tonyyy]

Another approach...

Sub StartSubfolderLoop()
Dim FolderPath As String

With Application.FileDialog(msoFileDialogFolderPicker)
  .AllowMultiSelect = False
  .Show
  FolderPath = .SelectedItems(1) & "\"
End With

Sheets.Add after:=Sheets(Sheets.Count)
Cells(1, 1).Value = "Folder Name"
Cells(1, 2).Value = "Folder Size (bytes)"
Cells(1, 3).Value = "Files"
Cells(1, 4).Value = "Subfolders"

SubfolderLoop FolderPath, True
End Sub

Sub SubfolderLoop(SourceFolderName As String, IncludeSubfolders As Boolean)
Application.ScreenUpdating = False
Dim fso As Object, SourceFolder As Object, SubFolder As Object
Dim i As Long

Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.GetFolder(SourceFolderName)
Set SubFolder = CreateObject("Scripting.FileSystemObject")
i = Cells(Rows.Count, "A").End(xlUp).Row + 1

With SourceFolder
    Cells(i, 1).Value = .Name
    Cells(i, 2).Value = .Size
    Cells(i, 3).Value = .Files.Count
    Cells(i, 4).Value = .SubFolders.Count
    i = i + 1
End With

If IncludeSubfolders Then
    For Each SubFolder In SourceFolder.SubFolders
        SubfolderLoop SubFolder.Path, True
    Next SubFolder
End If

Set SourceFolder = Nothing
Set fso = Nothing
Columns.AutoFit
End Sub

Run StartSubfolderLoop - you will be prompted to select a folder, then the code will proceed to list each folder/subfolder and the requested properties.

Cheers,

tonyyy