by Roy Smol (3 Submissions)
Category: Databases/Data Access/DAO/ADO
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Thu 4th January 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Connect the Ms.Treeviev control with a (MDB) database Go here to see a screenshot and/or download a sample project:
API Declarations
http://members.fortunecity.com/poikmans/VB_Code/Auto_Connect_Recordset/Module.htm
VBcoders
'
' CONNECT THE MS TREEVIEVCONTROL AUTOMATICLY TO AN ACCESS DATABASE
'
' >> Extra need stuff ************************************************
' 1 - You need the Microsoft DAO 3.51 Object Library.
' add this by the menu -> Project , references
' 2 - Do you have placed a imagelist on your form
' connected with te treeviev ? You need to add
' there 3 images named "Open" "Closed" and "Child"
' >> Example call ************************************************
'
' SQL$ = "SELECT * FROM [GebruikersDromen] WHERE [Naam] LIKE 'Piet'*"
' Me.TreeView1 -> must be replaced with the name of your treeviewcontrol
' DbName$ = App.Path & "\mijndatabase.mdb"
' veld1 = "Here the name of the 1e field in the database"
' veld2 = "Hier de naam van te 2e veld" ''Optional
' veld3 = "Hier de naam van te 3e veld" ''Optional
' veld4 = "Hier de naam van te 4e veld" ''Optional
'
' Call AutoConnectRecordset(Me.TreeView1, DbName$, SQL$, veld1, veld2)
'
Public Sub AutoConnectRecordset(TV As TreeView, DbaseName As String, SQL_String$, Field1 As Variant, _
Optional Field2 As Variant, Optional Field3 As Variant)
stop ! >>> you need the Microsoft DAO 3.51 Object Library.
add this by the menu -> Project , references
stop ! >>> Do you have placed a imagelist on your form connected with te treeviev ?
You need to add there 3 images named "Open" "Closed" and "Child"
On Error GoTo fout:
Dim N_Level As Integer
Dim SQL$
'===========================================
Dim DbR1 As Recordset
Dim Db1 As Database
Set Db1 = OpenDatabase(DbaseName)
'============
Dim Node1 As Node, Node2 As Node, Node3 As Node, Node4 As Node, Node5 As Node, Node6 As Node, Node7 As Node
'===================
On Error GoTo skip1:
If Field1 <> "" Then N_Level = 1
If Field2 <> "" Then N_Level = 2
If Field3 <> "" Then N_Level = 3
skip1:
On Error GoTo 0
SQL$ = SQL_String$
If SQL$ = "" Then
MsgBox "Geef op z`n minst dit op: -->> SQL$ = SELECT * FROM [ TabelName ]"
End
End If
'================
TV.Nodes.Clear
TV.HideSelection = False
TV.LabelEdit = tvwManual
TV.LineStyle = tvwRootLines
Select Case N_Level
Case 1 '=====================================================================[ 1 levels ]
Set DbR1 = Db1.OpenRecordset(SQL$)
DbR1.MoveLast: maxrec = DbR1.RecordCount: DbR1.MoveFirst
ReDim veld1(maxrec + 1000)
'-----
For Record = 1 To maxrec
NodeItem$ = DbR1(Field1)
count_1 = count_1 + 1
If staat_In_Array(NodeItem$, veld1()) = False Then
'''TestFrm.List1.AddItem R$ & " <> " & R2$
veld1(count_1) = NodeItem$
'--
r$ = "R_" & veld1(count_1)
R2$ = veld1(count_1)
Set Node1 = TV.Nodes.Add(, , r$, R2$)
Node1.Tag = "Child"
Node1.Image = "Child"
End If
DbR1.MoveNext
Next Record
Case 2 '=====================================================================[ 2 levels ]
Set DbR1 = Db1.OpenRecordset(SQL$)
DbR1.MoveLast: maxrec = DbR1.RecordCount: DbR1.MoveFirst
ReDim veld1(maxrec), veld1_Check(maxrec)
ReDim veld2(maxrec), veld2_Check(maxrec)
'-----
For Record = 1 To maxrec
If IsNull(DbR1(Field1)) = False Then
NodeItem$ = DbR1(Field1)
c_1 = c_1 + 1
veld1(c_1) = DbR1(Field1)
veld2(c_1) = DbR1(Field2)
End If
DbR1.MoveNext
Next Record
'-----
For i = 1 To maxrec
If staat_In_Array(veld1(i), veld1_Check()) = False Then 'unieke sleutels
T1 = T1 + 1
veld1_Check(T1) = veld1(i)
r$ = "R_" & veld1(i)
R2$ = veld1(i)
Set Node1 = TV.Nodes.Add(, , r$, R2$)
Node1.Tag = "Closed"
Node1.Image = "Closed"
t2 = 0
For J = 1 To maxrec
'If staat_In_Array(veld2(j), veld2_Check()) = False Then 'unieke sub sleutels maken
If veld1(i) = veld1(J) Then ' geen dubbele subsleutels
t2 = t2 + 1
veld2_Check(t2) = veld2(J)
C$ = Str$(i + J) & "_" & veld2(J)
C2$ = veld2(J)
Set Node2 = TV.Nodes.Add(r$, tvwChild, C$, C2$)
Node2.Tag = "Child"
Node2.Image = "Child"
End If
'End If
Next J
End If
Next i
Case 3 '=====================================================================[ 3 levels ]
Set DbR1 = Db1.OpenRecordset(SQL$)
DbR1.MoveLast: maxrec = DbR1.RecordCount: DbR1.MoveFirst
ReDim veld1(maxrec), veld1_Check(maxrec)
ReDim veld2(maxrec), veld2_Check(maxrec)
ReDim veld3(maxrec), veld3_Check(maxrec)
'-----
For Record = 1 To maxrec
If IsNull(DbR1(Field1)) = False Then
NodeItem$ = DbR1(Field1)
c_1 = c_1 + 1
veld1(c_1) = DbR1(Field1)
veld2(c_1) = DbR1(Field2)
veld3(c_1) = DbR1(Field3)
End If
DbR1.MoveNext
Next Record
KeyNr = maxrec
'-----
For i = 1 To maxrec
If staat_In_Array(veld1(i), veld1_Check()) = False Then 'unieke sleutels
T1 = T1 + 1
veld1_Check(T1) = veld1(i)
r$ = "R_" & veld1(i)
R2$ = veld1(i)
Set Node1 = TV.Nodes.Add(, , r$, R2$)
Node1.Tag = "Closed"
Node1.Image = "Closed"
t2 = 0
ReDim veld2_Check(maxrec)
For J = i To maxrec
If veld1(i) = veld1(J) Then ' geen dubbele subsleutels
If staat_In_Array(veld2(J), veld2_Check()) = False Then 'unieke sub sleutels maken
t2 = t2 + 1
veld2_Check(t2) = veld2(J)
C$ = Str$(i + J * key_nr) & "_" & veld2(J)
C2$ = veld2(J)
Set Node2 = TV.Nodes.Add(r$, tvwChild, C$, C2$)
Node2.Tag = "Closed"
Node2.Image = "Closed"
T3 = 0
ReDim veld3_Check(maxrec)
For k = i To maxrec
If veld1(i) = veld1(k) Then ' geen dubbele subsleutels
If veld2(J) = veld2(k) Then ' geen dubbele subsleutels
If staat_In_Array(veld3(k), veld3_Check()) = False Then 'unieke sub sleutels maken
T3 = T3 + 1
veld3_Check(T3) = veld3(k)
key_nr = KeyNr + 1
D$ = Str$(key_nr + i + J + k) & "_" & veld3(k)
D2$ = veld3(k)
Set Node3 = TV.Nodes.Add(C$, tvwChild, D$, D2$)
Node3.Tag = "Child"
Node3.Image = "Child"
End If
End If
End If
Next k
End If
End If
Next J
End If
Next i
'MsgBox "klaar"
Case Else
End Select
'' TestFrm.Show
On Local Error Resume Next
DbR1.OpenRecordset.Close
Exit Sub
fout:
MsgBox Error(Err) & " In module Autoconnect Recordset"
End Sub
Sub TreeView_Collapse_Event(n As Node)
'' plaats deze code in de event
'' TreeView1_Collapse(ByVal Node As ComctlLib.Node)
'' DOEL:
'' zorg dat de Node bitmap een gesloten folder wordt
'====================================
' Call TreeView_Collapse_Event(Node)
'====================================
On Error Resume Next
If n.Tag <> "Child" Or n.Index = 1 Then n.Image = "closed"
End Sub
Public Sub TreeView_Expand_Event(n As Node)
'' plaats deze code in de event
'' Sub TreeView1_Expand(ByVal Node As ComctlLib.Node)
'' DOEL:
'' zorg dat de Node bitmap een Open folder wordt
'====================================
' Call TreeView_Expand_Event(Node)
'====================================
If n.Tag <> "Child" Or n.Index = 1 Then n.Image = "Open"
End Sub
Public Function Get_TreeView_Child(n As Node) As String
'' plaats deze code in de event
'' Sub TreeView1_NodeClick(ByVal Node As ComctlLib.Node)
'' DOEL:
'' zorg dat NodeItem$ geladen wordt alleen als op
'' een Child geklikt wordt
'====================================
' MijnChild= Get_TreeView_Child(Node)
'====================================
If n.Tag <> "Child" Then
NodeItem$ = ""
Get_TreeView_Child = ""
Else
NodeItem$ = n.Text
Get_TreeView_Child = n.Text
End If
End Function
Private Function staat_In_Array(NieuwItem, m_Array()) As Boolean
On Error Resume Next
''Upper = UBound(MyArray, 1) ' Returns 10.
''Upper = UBound(MyArray, 3) ' Returns 20.
''Upper = UBound(AnyArray) ' Returns 10.
If IsNull(NieuwItem) = False Then
' staat_In_Array = True: Exit Function
End If
If Trim(UCase$(NieuwItem)) = "" Then
staat_In_Array = True: Exit Function
End If
For a = 1 To UBound(m_Array)
Zoeknaar = Trim(UCase$(NieuwItem))
ZoekIn = Trim(UCase$(m_Array(a)))
If InStr(ZoekIn, Zoeknaar) <> 0 Then ' Returns 0.
staat_In_Array = True: Exit For
End If
Next a
End Function
No comments have been posted about Connect the Ms.Treeviev control with a (MDB) database Go here to see a screenshot and/or download a. Why not be the first to post a comment about Connect the Ms.Treeviev control with a (MDB) database Go here to see a screenshot and/or download a.
