Question

任何人都可以帮我在树视图中添加我电脑的所有驱动器。

       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

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

Answer 1

我不确定您的代码示例中您要执行的操作。如果要将驱动器添加到树视图中，请迭代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

如何在vb 6.0中的树视图控件中添加驱动器（如窗口浏览器）

1 个答案: