如何在VB6.0的树状视图控件中添加驱动器（如窗口资源管理器）

有人能帮我在树状视图中添加计算机的所有驱动器吗

       Dim fs As New FileSystemObject

       Private Sub Form_Load()
         Dim path As String
         path = "D:\MP3"
            TreeView1.Nodes.Add , , path, path
            Call addtotree(path, TreeView1)
       End Sub
       Private Sub addtotree(path As String, tv As TreeView)
       Dim folder1 As Folder
            For Each folder1 In fs.GetFolder(path).SubFolders
                   tv.Nodes.Add path, tvwChild, path & "\" & folder1.Name, folder1.Name
                   Call addtotree(path & "\" & folder1.Name, tv)
            Next
       End Sub

---

我这样做是为了添加节点和子节点，但我不知道如何动态添加所有驱动器和文件夹，比如WindowExplorer

从您的代码示例中，我不确定您想做什么。如果要将驱动器添加到树状视图，请迭代

FileSystemObject.drives

集合。如果您试图填充驱动器下的文件夹，请获取驱动器，并在用户展开驱动器时找到驱动器下的文件夹。下面是一个获取驱动器的示例

Option Explicit

Private Const EXPANDING = " (expanding...)"

Private Sub LoadDrives(ByVal TreeviewCtrl As TreeView)
    Dim objFso As FileSystemObject
    Dim objDrive As Drive
    Dim objNode As MSComctlLib.Node

    On Error GoTo errLoadDrives

    Me.MousePointer = vbHourglass

    TreeviewCtrl.Nodes.Clear
    Set objFso = New FileSystemObject
    For Each objDrive In objFso.Drives
        Set objNode = TreeView1.Nodes.Add(, tvwFirst, objDrive.Path, objDrive.Path & "\" & IIf(Len(objDrive.ShareName) > 0, " (" & Replace$(objDrive.ShareName, "\\", "") & ")", ""))
        If objDrive.IsReady Then
            If objDrive.RootFolder.SubFolders.Count > 0 Then
                TreeviewCtrl.Nodes.Add objNode, tvwChild
            End If
        End If
    Next objDrive
    Me.MousePointer = vbDefault

    Exit Sub

errLoadDrives:
    Set objFso = Nothing
    Me.MousePointer = vbDefault
End Sub

Private Sub TreeView1_Expand(ByVal Node As MSComctlLib.Node)

    On Error GoTo errTreeView1_Expand

    Me.MousePointer = vbHourglass
    Node.Text = Node.Text & EXPANDING ' user feedback for longer operations
    TreeView1.Refresh
    Call AddToTree(Node)
    Node.Text = Replace$(Node.Text, EXPANDING, "")
    Me.MousePointer = vbDefault

    Exit Sub

errTreeView1_Expand:
    Me.MousePointer = vbDefault
    MsgBox "There was an error getting the child folders." & vbCrLf & vbCrLf & "Error " & CStr(Err.Number) & ", " & Err.Description, vbOKOnly + vbCritical, Err.Source


End Sub

Private Sub AddToTree(ByVal Node As MSComctlLib.Node)
    Dim strPath As String
    Dim objParentNode As MSComctlLib.Node
    Dim objFso As FileSystemObject
    Dim objFolder As Folder
    Dim objSubFolder As Folder
    Dim objFile As File
    Dim objNode As MSComctlLib.Node

    On Error GoTo errAddToTree

    ' remove any place holder node
    If Node.Child.Key = "" Then
        TreeView1.Nodes.Remove Node.Child.Index
    End If

    strPath = Node.Key & "\"  ' get the path of the current node

    Set objFso = New FileSystemObject
    Set objFolder = objFso.GetFolder(strPath)
    For Each objSubFolder In objFolder.SubFolders
        Set objNode = TreeView1.Nodes.Add(Node, tvwChild, objSubFolder.Path, objSubFolder.Name)
        If objSubFolder.SubFolders.Count > 0 Or objSubFolder.Files.Count > 0 Then ' add an empty place holder node
            TreeView1.Nodes.Add objNode, tvwChild
        End If
    Next objSubFolder
    For Each objFile In objFolder.Files
        TreeView1.Nodes.Add Node, tvwChild, Node.Key & "\" & objFile.Name, objFile.Name, "leaf"
    Next objFile

    Node.EnsureVisible

    Exit Sub

errAddToTree:
    If Err.Number = 70 Then 'permission denied - ignore it and move on
        Resume Next
    End If

End Sub

---

你做这件事就像你现在做的一样。使用FileSystemObject迭代驱动器下的文件夹并将其添加到驱动器节点。@user3085836我编辑我的答案是为了明确显示如何修改和使用现有代码添加子文件夹。您好，jac您的代码没有扩展任何文件夹或文件。它仅在treeview中显示驱动器号。@user3085836需要添加代码以在驱动器下创建占位符子节点。@user3085836只需添加一个空的子节点。它的唯一目的是创建复选框/允许父节点展开。当您真正填充子节点时，您要做的第一件事是删除空节点。