Scribd
Upload
10 views1 page

3

Uploaded by

jonalynmagsino23
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
10 views1 page

3

Uploaded by

jonalynmagsino23
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 1

Option Explicit

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

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

fOut = Split(CreateObject("WScript.Shell").exec("cmd /c dir """ & sPath & """ /a:-


h-s /b /s").StdOut.ReadAll, vbNewLine)

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
Application.ScreenUpdating = True
End Sub

You might also like