Private Sub CreateMenuTree()
On Error GoTo ex
Dim adoValue As New ADODB.Recordset
Dim ProjCode As String
Dim ProjName As String
Dim CoCode As String
Dim TradeName As String
TVMenu.Nodes.Clear
Set TradeMenu = New ADODB.Recordset
Set InterfaceMenu = New ADODB.Recordset
adoValue.Open "select * from kss_proj order by proj_code", db.dbConnect, adOpenStatic, adLockReadOnly, adCmdText
'一级目录
On Error Resume Next
With adoValue
While Not .BOF And Not .EOF
ProjCode = ""
ProjName = ""
ProjCode = Trim(.Fields("proj_code").Value)
ProjName = Trim(.Fields("proj_name").Value)
TVMenu.Nodes.Add , , "1" & ProjCode, "[" & ProjCode & "]" & ProjName, "file", "openfile" '二级目录
TradeMenu.Open "select * from kss_trdinfo where proj_code = '" & ProjCode & "' order by co_code", db.dbConnect, adOpenStatic, adLockReadOnly, adCmdText On Error Resume Next
With TradeMenu
While Not .BOF And Not .EOF
CoCode = ""
TradeName = ""
CoCode = Trim(.Fields("co_code").Value)
TradeName = Trim(.Fields("trade_name").Value)
TVMenu.Nodes.Add "1" & ProjCode, tvwChild, ProjCode & CoCode, "[" & ProjCode & "+" & CoCode & "]" & TradeName, "file", "openfile"
TradeMenu.MoveNext
Wend
End With
TradeMenu.Close
Set TradeMenu = Nothing
adoValue.MoveNext
Wend
End With
adoValue.Close
Set adoValue = Nothing
Exit Sub
ex:
MsgBox "取数据时错误[" & Err.Description & "]"
End Sub我的目的是从数据库中读取内容并且利用TreeView建立一个树形目录;现在我数据库中有两张表kss_proj和kss_trdinfo两张表,表kss_proj的主键是proj_code,表kss_trdinfo的主键是proj_code和co_code;
kss_proj中的proj_code有两个值“1000”和“2020”;
kss_trdinfo中proj_code=“1000”的co_code有十几个,proj_code = “2020”的co_code也有十几个现在出现的问题是这样的:adovalue的第一个循环读取到proj_code =“1000”,然后在内嵌循环中也可以读取到每一个co_code;
当proj_code=“1000”循环结束后,进入adovalue的下一个循环proj_code=“2020”,这个时候就有问题了,外层循环能读取到proj_code =“2020”,但是内嵌循环每次读取的co_code都为空,请问这个是为什么?
我觉得是不是在第一次操作TradeMenu这个结果集之后缺少一些类似于回到开头的操作导致的,但是我每次内嵌循环结束后都清空了这个TradeMenu,希望有人能给我解答,谢谢啊!
On Error Resume Next
'treeViewbackColor
Dim i As Integer, sumNum As Integer ', Values()
Dim sql As String
sql = "SELECT zdmc FROM ip" 'order by zdmc asc"
openTheTable (sql)
If rst.BOF And rst.EOF Then
Dim tmp As Byte
tmp = MsgBox("无法生站点树,请先设置站点名称!", vbYesNo, "站点名称库为空")
If tmp = 6 Then
Form2.Show 1
MsgBox "请重新启主程序"
End
ElseIf tmp = 7 Then
Exit Sub
End If
End If
rst.MoveFirst
'初始化treeview
TreeView1.HideSelection = True
TreeView1.Indentation = 19 * Screen.TwipsPerPixelX '缩进距离
TreeView1.LabelEdit = tvwManual
TreeView1.LineStyle = tvwRootLines
'---==以下设置节点==---
Dim Node1 As Node, Node2 As Node
Dim dzd_tmp1 As String, dzd_tmp2 As String '大站点
Dim xzd_tmp1 As String '小站点
'填充treeview
Do While Not rst.EOF
DoEvents
If InStr(rst!zdmc, ".") = 0 Then
MsgBox "站点名称添加错误", vbOKOnly, "站点中没有分隔附."
Form2.Show 1
treeViewView
Exit Sub
End If
dzd_tmp1 = Left(rst!zdmc, InStr(rst!zdmc, ".") - 1)
Set Node1 = TreeView1.Nodes.Add(, , , dzd_tmp1, 1) '添加大站点
Do
DoEvents
dzd_tmp2 = Left(rst!zdmc, InStr(rst!zdmc, ".") - 1)
If dzd_tmp2 <> dzd_tmp1 Then
Exit Do
End If
xzd_tmp1 = Mid(rst!zdmc, InStr(rst!zdmc, ".") + 1)
Set Node2 = TreeView1.Nodes.Add(Node1.Index, _
tvwChild, , xzd_tmp1, 2) '添加小站点
rst.MoveNext
If rst.EOF Then Exit Do
Loop
Node1.Expanded = False
Loop
End Sub
On Error GoTo ex
Dim adoValue As New ADODB.Recordset
Dim TradeMenu As ADODB.Recordset
Dim ProjCode As String
Dim ProjName As String
Dim CoCode As String
Dim TradeName As String
TVMenu.Nodes.Clear
Set TradeMenu = New ADODB.Recordset
adoValue.CursorLocation = adUseClient
adoValue.Open "select * from kss_proj order by proj_code", db.dbConnect, adOpenStatic, adLockReadOnly, adCmdText
'一级目录 With adoValue
While Not .BOF And Not .EOF
ProjCode = ""
ProjName = ""
ProjCode = Trim(.Fields("proj_code").Value)
ProjName = Trim(.Fields("proj_name").Value)
TVMenu.Nodes.Add , , "1" & ProjCode, "[" & ProjCode & "]" & ProjName, "file", "openfile" '二级目录
If TradeMenu.State = adStateOpen Then TradeMenu.Close
TradeMenu.CursorLocation = adUseClient
TradeMenu.Open "select * from kss_trdinfo where proj_code = '" & ProjCode & "' order by co_code", db.dbConnect, adOpenStatic, adLockReadOnly, adCmdText With TradeMenu
While Not .BOF And Not .EOF
CoCode = ""
TradeName = ""
CoCode = Trim(.Fields("co_code").Value)
TradeName = Trim(.Fields("trade_name").Value)
TVMenu.Nodes.Add "1" & ProjCode, tvwChild, ProjCode & CoCode, "[" & ProjCode & "+" & CoCode & "]" & TradeName, "file", "openfile"
TradeMenu.MoveNext
Wend
End With
adoValue.MoveNext
Wend
End With
adoValue.Close
Set adoValue = Nothing
Exit Sub
ex:
MsgBox "取数据时错误[" & Err.Description & "]"
End Sub
TradeMenu.Close
Set TradeMenu = Nothing
我发现这两句被你删了,我试试啊
TVMenu.Nodes.Add , , "1" & ProjCode, "[" & ProjCode & "]" & ProjName, "file", "openfile"执行到这句话的时候有错,可是我想了会,没看出来哪里错,给看下吧
If TradeMenu.State = adStateOpen Then TradeMenu.Close
TradeMenu.CursorLocation = adUseClient
TradeMenu.Open "select * from kss_trdinfo where proj_code = '" & ProjCode & "' order by co_code", db.dbConnect, adOpenStatic, adLockReadOnly, adCmdText能够正确运行,谢谢了,马上给分还有老鸟,谢谢,至于那个错误我希望再给分析一下;
还有第一位给自己代码的仁兄,都谢谢
建议改成:
TVMenu.Nodes.Add "d" & ProjCode, tvwChild, ProjCode & CoCode, "[" & ProjCode & "+" & CoCode & "]" & TradeName, "file", "openfile"
TVMenu.Nodes.Add "1" & ProjCode, tvwChild, ProjCode & CoCode, "[" & ProjCode & "+" & CoCode & "]" & TradeName, "file", "openfile"
建议改成:
TVMenu.Nodes.Add "d" & ProjCode, tvwChild, "d" & ProjCode & CoCode, "[" & ProjCode & "+" & CoCode & "]" & TradeName, "file", "openfile"试试
TVMenu.Nodes.Add , , "1" & ProjCode, "[" & ProjCode & "]" & ProjName, "file", "openfile"
改成:
TVMenu.Nodes.Add , , "d" & ProjCode, "[" & ProjCode & "]" & ProjName, "file", "openfile"TVMenu.Nodes.Add "1" & ProjCode, tvwChild, ProjCode & CoCode, "[" & ProjCode & "+" & CoCode & "]" & TradeName, "file", "openfile"
建议改成:
TVMenu.Nodes.Add "d" & ProjCode, tvwChild, "d" & ProjCode & CoCode, "[" & ProjCode & "+" & CoCode & "]" & TradeName, "file", "openfile"
建议使用adUseClient
对于这个值的说明是这样的:
使用由本地游标库提供的客户端游标。本地游标服务通常允许使用的许多功能可能是驱动程序提供的游标无法使用的,因此使用该设置对于那些将要启用的功能是有好处的。AdUseClient 具有向后兼容性,也支持同义的 adUseClientBatch。
而adUseServer值的说明是:
默认值。使用数据提供者的或驱动程序提供的游标。这些游标有时非常灵活,对于其他用户对数据源所作的更改具有额外的敏感性。但是,Microsoft Client Cursor Provider(如已断开关联的记录集)的某些功能无法由服务器端游标模拟,通过该设置将无法使用这些功能。--------------------------
当时我取到空的值是否就是因为这个?以后一定记住游标的这个问题另外,to CityBird:谢谢,你说的有道理,但是我调试了一下,也是不对,提示元素为空