Chương trình tự tổng hợp các thư mục trong đường dẫn đã cho và tạo List cây thư mục giống hệt trên Web

Link tải chương trình : Tại đây
Code sử dụng:

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim xRow As Long
Dim s As String


Dim xDirect$, xFname$, InitialFoldr$

InitialFoldr$ = "C:\Users\cuongnh\Desktop\"

With Application.FileDialog(msoFileDialogFolderPicker)

.InitialFileName = Application.DefaultFilePath & "\"

.Title = "Please select a folder to list Files from"

.InitialFileName = InitialFoldr$

.Show

s = .SelectedItems(1)

Target.Value = s

Cells(Target.Row - 1, Target.Column + 1).Select

If .SelectedItems.Count <> 0 Then

xDirect$ = .SelectedItems(1) & "\"

xFname$ = Dir(xDirect$, 7)

    Do While xFname$ <> ""
    'ActiveCell.Offset(xRow).Select
    ActiveCell.Offset(1).Select
    ActiveCell = xFname$

    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=.SelectedItems(1) & "\" & xFname$
    ActiveCell.Offset(0, -1) = s
    'xRow = xRow + 1

    xFname$ = Dir

    Loop

End If

End With

ActiveSheet.PivotTables("PivotTable6").PivotCache.Refresh

End Sub