List Files Sorted Alphabetically and Grouped by Folder

BadDogTitan

New Member
Joined
Sep 16, 2013
Messages
18
The following macro groups files by folder and produces the desired output. However, it is very slow when it runs on a large directory, like 'My Pictures' with 30,000+ files.

I suspect I don't need a double loop, or perhaps I can use an array, but I am fairly new to VBA, and not sure how to implement.

Can anyone help?

Thanks.


Code:
[FONT=Verdana]Option Explicit[/FONT]
[FONT=Verdana]Sub cmdList()
    Dim objShell    As Object
    Dim objFolder   As Object
    Dim sPath       As String
    Dim fOut        As Variant
    Dim r           As Integer
    Dim listRng     As Range
    Dim cell        As Range
    Dim i           As Integer
    Dim j           As Integer[/FONT]
[FONT=Verdana]    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, "Select Folder", 0, 17)
    If objFolder Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    sPath = objFolder.self.Path
    Set objFolder = Nothing: Set objShell = Nothing
    
    r = 6: Range(r & ":" & Rows.Count).Delete
    Cells(r - 1, 1) = sPath[/FONT]
[FONT=Verdana]    fOut = Split(CreateObject("WScript.Shell").exec("cmd /c dir """ & sPath & """ /a:-h-s /b /s").StdOut.ReadAll, vbNewLine)[/FONT]
[FONT=Verdana]    Cells(r, 1).Resize(UBound(fOut), 1) = WorksheetFunction.Transpose(fOut)
    
    Set listRng = Cells(r, 1).CurrentRegion
    listRng.Sort Key1:=Cells(r, 1), Order1:=xlAscending, Header:=xlYes
    
    For i = 1 To listRng.Count
        For j = i + 1 To listRng.Count
            If InStr(listRng.Cells(j), listRng.Cells(i)) Then
                With listRng.Cells(j)
                    .Rows.Group
                    .IndentLevel = .Rows.OutlineLevel - 1
                End With
            Else
                Exit For
            End If
        Next j
    Next i
    ActiveSheet.Outline.SummaryRow = xlAbove
    Application.ScreenUpdating = True
End Sub[/FONT]
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type

Forum statistics

Threads
1,213,496
Messages
6,113,995
Members
448,539
Latest member
alex78

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top