Option Explicit
Private oSh As Worksheet
Private xRow As Long, aCount As Byte
Sub GPE()
Dim sFolder As String, aRow As Integer
Dim Root_Folder_Path As String, fso As Object, xFolder As Object
Dim iSh As Worksheet
Set oSh = ThisWorkbook.Sheets(1)
aRow = oSh.Range("C1000").End(xlUp).Row
If aRow > 1 Then oSh.Range("A2:D" & aRow).Clear
sFolder = ThisWorkbook.Path
Set fso = CreateObject("Scripting.FileSystemObject")
Set xFolder = fso.getFolder(sFolder)
xRow = 2: aCount = 1
List_Subfolders xFolder, aCount
aRow = oSh.Range("C1000").End(xlUp).Row
If aRow > 1 Then oSh.Range("A2:D" & aRow).Borders.LineStyle = xlContinuous
oSh.Columns.AutoFit
Set xFolder = Nothing
Set fso = Nothing
MsgBox "Hoan thanh"
End Sub
Sub List_Subfolders(ByRef objFolder As Object, CheckSub As Byte)
Dim SubFolder As Object
If CheckSub < 3 Then
While oSh.Cells(xRow, 1) <> ""
xRow = xRow + 1
Wend
If CheckSub = 2 Then xRow = xRow - 1
For Each SubFolder In objFolder.SubFolders
oSh.Cells(xRow, CheckSub + 1).Value = "'" & SubFolder.Name
If CheckSub = 2 Then
oSh.Cells(xRow, CheckSub + 2).Value = SubFolder.Path & "\"
oSh.Hyperlinks.Add Anchor:=oSh.Cells(xRow, CheckSub + 2), Address:=SubFolder.Path & "\", TextToDisplay:=SubFolder.Path & "\"
End If
xRow = xRow + 1
List_Subfolders SubFolder, CheckSub + 1
Next SubFolder
End If
End Sub
