Folder List with Size

[mroseto]

Hello,

Is there a way to get a listing of folders in a directory (C:\) with the size of the folder?

Thanks

Mike

 

[Case_Germany]

Hi,

with the following code - however, if you have many (sub)folders the code needs a long time.

Option Explicit
Dim lngRow As Long

Public Sub Test()
    Dim varPath As Variant
    Set varPath = Application.FileDialog(msoFileDialogFolderPicker)
    lngRow = 1
    With varPath
        .Title = "Folder..."
        .InitialFileName = "C:\"
        If .Show = -1 Then fncFolders .SelectedItems(1), True ' True with Subfolders
    End With
End Sub

Public Sub fncFolders(varFolder As Variant, Optional blnSubFolder As Boolean = False)
    Dim objSubFolder As Object
    Dim objFile As Object
    Dim objFSO As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.getfolder(varFolder)
    On Error Resume Next ' Since some system directories errors release
    Select Case blnSubFolder
        Case True
            For Each objSubFolder In objFile.subfolders
                Cells(lngRow, 1) = objSubFolder.Path
                Cells(lngRow, 2) = Format(objSubFolder.Size / 1024 / 1024, "0.0 \MB")
                lngRow = lngRow + 1
                fncFolders objSubFolder, True
            Next
        Case False
            For Each objSubFolder In objFile.subfolders
                Cells(lngRow, 1) = objSubFolder.Path
                Cells(lngRow, 2) = Format(objSubFolder.Size / 1024 / 1024, "0.0 \MB")
                lngRow = lngRow + 1
            Next
    End Select
    Set objFSO = Nothing
    Set objFile = Nothing
End Sub

The faster way:

PowerShell

Case_Germany

 

[mroseto]

I'm getting a compile error when running it. Unfortunately I have zero ability to fix this.

If you could help I would greatly appreciate it.

Thanks

Mike

 

[Case_Germany]

Hi,

which Excel version?

Case_Germany

 

[mroseto]

Hi there,

I tested it on my excel 2000. It does work with 2003 so that will do exactly what I need. Thanks for all your help.

Mike

 

[Case_Germany]

Hi,

for Excel 97 and Excel 2000:

Option Explicit
Dim lngRow As Long

Public Sub Test()
    Dim objShell As Object
    Dim varDir As Variant
    Dim strPath As String
    Set objShell = CreateObject("Shell.Application")
    Set varDir = objShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
    On Error Resume Next
    strPath = varDir.Self.Path
    If strPath <> "" Then
        If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
        On Error GoTo 0
        fncFolders strPath, True ' True with Subfolders
    Else
        MsgBox "No folder selected!"
    End If
End Sub

Public Sub fncFolders(varFolder As Variant, Optional blnSubFolder As Boolean = False)
    Dim objSubFolder As Object
    Dim objFile As Object
    Dim objFSO As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.getfolder(varFolder)
    On Error Resume Next ' Since some system directories errors release
    Select Case blnSubFolder
        Case True
            For Each objSubFolder In objFile.subfolders
                Cells(lngRow, 1) = objSubFolder.Path
                Cells(lngRow, 2) = Format(objSubFolder.Size / 1024 / 1024, "0.0 \MB")
                lngRow = lngRow + 1
                fncFolders objSubFolder, True
            Next
        Case False
            For Each objSubFolder In objFile.subfolders
                Cells(lngRow, 1) = objSubFolder.Path
                Cells(lngRow, 2) = Format(objSubFolder.Size / 1024 / 1024, "0.0 \MB")
                lngRow = lngRow + 1
            Next
    End Select
    Set objFSO = Nothing
    Set objFile = Nothing
End Sub

Case_Germany