Sub Tree()
    Dim sql$, r As Integer, Maxclass As Byte, I As Byte
    Application.ScreenUpdating = False
    Set cnn = CreateObject("ADODB.connection")
    Set rst = CreateObject("adodb.recordset")
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\ZyDe.mdb"
 
  With UserForm2.TreeView1
        .Nodes.Clear
        '.ImageList = UserForm2.ImageList1
        .LineStyle = tvwRootLines
        .Style = tvwTreelinesPlusMinusPictureText
        .Visible = False

        sql = "SELECT len(max(NewPid*1))/2 From zjb "    '科目大类别
        rst.Open sql, cnn, 3, 1
        If rst.RecordCount <> 0 Then
            Maxclass = rst.fields(0)                              '取得科目多少级数
            rst.Close
        End If

        sql = "SELECT left(NewPid,1), NewID From  zjb group by  left(NewPid,1), NewID  "   '科目大类别
        rst.Open sql, cnn, 3, 1
        If rst.RecordCount <> 0 Then
            For r = 1 To rst.RecordCount
                .Nodes.Add(, , "abc" & rst.fields(0), rst.fields(0) & "-" & rst.fields(1)).Tag = 1
                rst.movenext
            Next
            rst.Close
        End If

        sql = "SELECT NewPid,MC From zjb where len(NewPid)=4  Order by NewPid "  'MCASC,DESC
        rst.Open sql, cnn, 3, 1
        If rst.RecordCount <> 0 Then
            For r = 1 To rst.RecordCount
                .Nodes.Add("abc" & Left(rst.fields(0), 1), tvwChild, "abc" & rst.fields(0), rst.fields(0) & "-" & rst.fields(1)).Tag = 2
                rst.movenext
            Next
            rst.Close
        End If

        For I = 1 To (Maxclass - 2)                                               '明细科目
            sql = "SELECT NewPid,MC,Bz From zjb where len(NewPid) = " & I * 2 + 4 & ";"
            rst.Open sql, cnn, 3, 1
            If rst.RecordCount <> 0 Then
                For r = 1 To rst.RecordCount
                    .Nodes.Add("abc" & Left(rst.fields(0), I * 2 + 2), tvwChild, "abc" & rst.fields(0), rst.fields(0) & "-" & rst.fields(2)).Tag = I + 2
                    rst.movenext
                Next
                rst.Close
            End If
        Next

        cnn.Close
        Set rst = Nothing
        .Visible = True
    End With
    Application.ScreenUpdating = True
End Sub