I pulled this code from my archieves. It does exactly what you want and also
gets the sizes (bytes) of each folder.
Dim RowNumber
Sub GetFolderSize()
strFolder = "C:"
RowNumber = 1
Set fso = CreateObject _
("Scripting.FileSystemObject")
Set folder = _
fso.GetFolder(strFolder)
Sheets(1).Cells(RowNumber, 1) = strFolder + "\"
Sheets(1).Cells(RowNumber, 2) = folder.Size
RowNumber = RowNumber + RowNumber
Call GetSubFolderSize(strFolder + "\")
End Sub
Sub GetSubFolderSize(strFolder)
Set fso = CreateObject _
("Scripting.FileSystemObject")
Set folder = _
fso.GetFolder(strFolder)
If folder.subfolders.Count > 0 Then
For Each sf In folder.subfolders
On Error GoTo 100
Call GetSubFolderSize(strFolder + sf.Name + "\")
100 Next sf
End If
'folder size in bytes
On Error GoTo 200
If Not folder.isrootfolder Then
FolderSize = folder.Size
Sheets(1).Cells(RowNumber, 2) = FolderSize
Sheets(1).Cells(RowNumber, 1) = strFolder
RowNumber = RowNumber + 1
End If
200 On Error GoTo 0
End Sub