Dùng khung hiển thị hình cây (TreeView) với VBA

Trong ví dụ dưới đây ta hiển thị các thư mục (folder) của một ổ đĩa (drive) trong khung hiển thị dạng cây (TreeView) của VBA. Ta tạo một hộp thoại (dialog) gồm :
- Một thanh cuộn (ComboBox) tên cbDisc : chứa danh sách các ổ đĩa của máy tính.
- Môt khung hiển thị dạng cây : khi ta chọn một ổ đĩa trong danh sách cuộn phía trên, khung này sẽ hiển thị các thư mục của ổ đĩa vừa được chọn.




Dưới đây là mã nguồn của hộp thoại trên :

Option Explicit

Private Sub cbDisc_Change()
    Call PopulateTreeViewFolder
End Sub

Private Sub UserForm_Initialize()
    Call PopulateDiscList
End Sub

Sub PopulateDiscList()
    Dim objDrv      As Object
    
    cbDisc.Clear
    ' get a list of all disc in PC
    For Each objDrv In CreateObject("Scripting.FileSystemObject").drives
        ' add disc path to combobox cbDisc
        cbDisc.AddItem objDrv.Path
    Next
    
    Set objDrv = Nothing
    ' assign a default value for combobox cbDisc
    cbDisc.Value = cbDisc.Column(0, 0)
End Sub

Private Sub UserForm_Terminate()
    Unload Me
End Sub

Sub PopulateTreeViewFolder()
    Dim Dir As String
    
    Dir = cbDisc.Value
    ' clear all nodes in TreeView before adding to it
    TreeViewFolder.Nodes.Clear
    If Dir <> "" Then
        ' add node root first
        TreeViewFolder.Nodes.Add , , Dir, Dir
        ' call a recursive function upto 2 level of subfolder
        Call AddToTree(Dir, 2)
    End If
    With TreeViewFolder.Nodes
        If .Count > 0 Then
            ' expand the root node by default
            .Item(1).Expanded = True
        End If
    End With
End Sub

Sub AddToTree(Dir As String, level As Integer)
    ' if level equals 0, exit function
    If level = 0 Then
        Exit Sub
    End If
    Dim objFso As Object
    Dim oFolder As Object
    Set objFso = CreateObject("Scripting.FileSystemObject")
    On Error GoTo errorHandler
    For Each oFolder In objFso.GetFolder(Dir & "\").SubFolders
        TreeViewFolder.Nodes.Add Dir, 4, oFolder.Path, oFolder.Name
        ' call recursive function AddToTree to add all subfolders to this folder
        Call AddToTree(oFolder.Path, level - 1)
    Next
    Set objFso = Nothing
    Set oFolder = Nothing
    Exit Sub
errorHandler:
    Set objFso = Nothing
    Set oFolder = Nothing
End Sub

Giải thích mã :
- Khi hộp thoại hiển thị, hàm UserForm_Initialize() sẽ gọi hàm PopulateDiscList để tạo lập danh sách ổ đĩa hiển thị trong thanh cuộn cbDisc.
- Thanh cuộn được gán giá trị mặc định là ổ đĩa đầu tiên trong danh sách, và hàm cbDisc_Change() được gọi.
- Hàm PopulateTreeViewFolder được gọi để cập nhật nội dung của Khung hiển thị hình cây. Trong ví dụ, ta chỉ hiển thị thư mục con đến tầng thứ hai : level được gán giá trị 2 khi gọi hàm AddToTree. AddToTree là hàm đệ quy.