mdb升级成adp后treeview无法显示菜单

zjhzyubin

f:\treeview.jpg
mdb升级成adp后treeview无法显示菜单,mdb中正常能读取表中数据为菜单项，ADP中提示对象变量未设置。可能无法读取SQL中表数据所致，但不知要改哪一个语句，如何写？
Private Sub Form_Load()

      On Error GoTo ErrForm_Load
      Dim db As Database, Rst As Recordset, nodCurrent As Node
      Dim objTree As TreeView, strText As String, nodRoot As Node
      Dim bk As String

      Set db = CurrentDb
      Set Rst = db.OpenRecordset("SwitchboardItems", dbOpenDynaset, dbReadOnly)

      Set objTree = Me!xTree.Object
      ' 查找第一个上级
      Rst.FindFirst "[ItemNumber] Is Null"
      ' 向TREEVIEW装入数据
      Do Until Rst.NoMatch
         ' 取得科目名称
         strText = Rst![ItemText]
         ' TREEVIEW第一层.
         Set nodCurrent = objTree.Nodes.Add(, , "a" & Rst!ID, strText, 1, 2)
         ' 装记录位置存入变量.
         bk = Rst.Bookmark
         ' 用递归过程加入子节点（调用）
         AddChildren nodCurrent, Rst
         ' 返回原位
         Rst.Bookmark = bk
         ' 查找下一个上级
         Rst.FindNext "[ItemNumber] Is Null"
      Loop

ExitForm_Load:
         Exit Sub
ErrForm_Load:
         MsgBox Err.Description, vbCritical, "Load Error:"
         Resume ExitForm_Load
      
      End Sub

      '==================================================================
      '子过程，加入子节点及孙节点
      '==================================================================
      Sub AddChildren(nodBoss As Node, Rst As Recordset)
      On Error GoTo ErrAddChildren
      Dim nodCurrent As Node
      Dim objTree As TreeView, strText As String, bk As String

      ' 变量.
      Set objTree = Me!xTree.Object
      ' 查找第一个子节点
      Rst.FindFirst "[ItemNumber] =" & Mid(nodBoss.Key, 2)
      ' 装入数据
      Do Until Rst.NoMatch
         ' 取得科目名称.
         strText = Rst![ItemText]
         ' 加入子节咪.
         Set nodCurrent = objTree.Nodes.Add(nodBoss, tvwChild, "a" & Rst!ID, strText, 1, 2)
         ' 保存位置
         bk = Rst.Bookmark
         ' 装入下层节点
         AddChildren nodCurrent, Rst
         ' 返回并继续查找
         Rst.Bookmark = bk
         ' 查找下一个
         Rst.FindNext "[ItemNumber]=" & Mid(nodBoss.Key, 2)
      Loop

ExitAddChildren:
         Exit Sub
ErrAddChildren:
         MsgBox Err.Description, vbCritical, "AddChildren Error:"
         Resume ExitAddChildren
End Sub

zjhzyubin

上传图片

zjhzyubin

谢谢朱老师，看来要要再学习一下ADO知识。