List folders and sub-folders of a path with its size

Flora Edwards
Flora Edwards used Ask the Experts™
i have seen couple of codes on the net for listing files from folders and sub folders, which does not really help me.

what i need is a VBA to run from Excel

prompts me to select a folder then once select it lists all folders and sub-folders from this path showing the followings information
Folder name,  Folder path , Folder Date created, Folder Size in Mega bites

Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Bill PrewTest your restores, not your backups...
Top Expert 2016

Where do you want the "list" to be placed - in a text file, in an Excel sheet, etc?

No files are to be listed, just folders, correct?

Flora EdwardsMedicine


thanks Bill.

Yes,  files to be shown in Excel

No files,  just folders and its sub-folders
Test your restores, not your backups...
Top Expert 2016
Here's a basic starting point that will get you close.  Add this VBA code and run the first subroutine.  Make sure you add a reference to Microsoft Scripting Runtime.

Option Explicit

Sub Folders()
    Application.ScreenUpdating = False
    Dim strFolder As String
    Dim objSheet As Worksheet
    Dim objFolderPicker As Object
    Set objFolderPicker = Application.FileDialog(msoFileDialogFolderPicker)
    objFolderPicker.Title = "Choose the folder"
    If objFolderPicker.SelectedItems.Count <> 1 Then
        Exit Sub
    End If
    strFolder = objFolderPicker.SelectedItems(1) & "\"
    Set objSheet = ActiveWorkbook.Sheets.Add(, Worksheets(Worksheets.Count))
    objSheet.Cells(1, 1).Value = "Name"
    objSheet.Cells(1, 2).Value = "Path"
    objSheet.Cells(1, 3).Value = "Created"
    objSheet.Cells(1, 4).Value = "Size (MB)"
    ListFolders objSheet, strFolder
    Application.ScreenUpdating = True
End Sub

Sub ListFolders(objSheet As Worksheet, strFolder As String)
    Dim objFSO As Scripting.FileSystemObject
    Dim objFolder As Scripting.Folder
    Dim objSubFolder As Scripting.Folder
    Dim lngRow As Long
    Set objFSO = New Scripting.FileSystemObject
    Set objFolder = objFSO.GetFolder(strFolder)
    lngRow = objSheet.Cells(objSheet.Rows.Count, 1).End(xlUp).Row + 1
    objSheet.Cells(lngRow, 1).Value = objFolder.Name
    objSheet.Cells(lngRow, 2).Value = objFolder.Path
    objSheet.Cells(lngRow, 3).Value = objFolder.DateCreated
    objSheet.Cells(lngRow, 4).Value = objFolder.Size / 1024 / 1024
    For Each objSubFolder In objFolder.SubFolders
        ListFolders objSheet, objSubFolder.Path
    Next objSubFolder
    Set objSubFolder = Nothing
    Set objFolder = Nothing
    Set objFSO = Nothing
End Sub

Open in new window

Flora EdwardsMedicine


many thanks Bill.

it worked.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial