POPULATE treeview with node rset access mdb....

i want populate a treeview i a form with node0 is firsts level is for the table AREA_TERR, click on node0 expand node1 with rset SPORTELLI click on node1 expand node3 with rset in DATI.
For test see the relation in Access from AREA_TERR the value 8505 expand 0500 (or 4500, 0501, eec)

1) If i understand, before to import rset in treeview is required to make a realtion from table or not?
2) is possible to populate a treeview without relation from the table?
if the solution 2 is possible is good for me because i dont ubdertnd very well access relation;-)

i use vb 6.0 and ADO
sal21Asked:
Who is Participating?
 
danaseamanConnect With a Mentor Commented:
Here is a better/faster way to do this using "INNER JOIN". The only problem is that the Field "DESCRIZIONE" is used in 2 Tables, therefore I renamed SPORTELLI "DESCRIZIONE" to "DESCRIZIONE2".


Option Explicit
 
Dim ADO_CONN         As ADODB.Connection
Dim ADO_RS           As ADODB.Recordset
   
Private Sub Form_Load()
 
   Dim sValue           As String
   Dim sKey             As String
   Dim sSQL             As String
   Dim i                As Long
   
   On Error Resume Next
   
   If Not ADOOpenConnection(App.Path & "\Past_Due_Test.mdb") Then
      Exit Sub
   End If
 
   sSQL = "Select * FROM (SPORTELLI INNER JOIN DATI ON SPORTELLI.SPORT = DATI.PROVA2) " & _
          "INNER JOIN AREA_TERR ON SPORTELLI.REGIONE = AREA_TERR.COD_AREA ORDER BY SPORTELLI.SPORT"
   
   With TreeView1
      ADOOpenRecordSet sSQL
      ADO_RS.MoveFirst
      Do Until ADO_RS.EOF
         sValue = ADO_RS.Fields("COD_AREA").Value
         sKey = "K" & sValue
         .Nodes.Add , , sKey, sValue & " - " & ADO_RS.Fields("DESCRIZIONE")
         sValue = ADO_RS.Fields("SPORT").Value
         .Nodes.Add sKey, tvwChild, "L" & sValue, sValue & " - " & ADO_RS.Fields("DESCRIZIONE2")
         sKey = "L" & sValue
         sValue = ""
         For i = 1 To 8
            If i <> 2 Then
               sValue = sValue & ADO_RS.Fields("PROVA" & i)
               If i < 8 Then
                  sValue = sValue & ", "
               End If
            End If
         Next
         .Nodes.Add sKey, tvwChild, "M" & sKey & sValue, sValue
         ADO_RS.MoveNext
      Loop
      ADO_RS.Close
      ADOCloseConnection
   End With
   
End Sub
 
Private Function ADOBuildConnStr(ByVal ServerOrFileIn As String, _
   Optional ByVal DBNameIn As String, _
   Optional ByVal UserNameIn As String, _
   Optional ByVal PasswordIn As String) As String
 
   On Error GoTo ErrRtn
 
 
   ADOBuildConnStr = "Driver={Microsoft Access Driver (*.mdb)};Dbq=" & ServerOrFileIn & _
      ";DefaultDir=" & RetPathOnly(ServerOrFileIn) & ";PWD=" & _
      IIf(LenB(PasswordIn), PasswordIn & ";", ";")
 
ProcExit:
   Exit Function
 
ErrRtn:
   On Error Resume Next
 
   MsgBox "ADOBuildConnStr created was:" & vbCrLf & ADOBuildConnStr, _
      vbCritical, _
      "Invalid ADOBuildConnStr"
 
Resume ProcExit:
End Function
 
Public Sub ADOCloseConnection()
   On Error GoTo ErrRtn
   If Not ADO_CONN Is Nothing Then
      ADO_CONN.Close
      Set ADO_CONN = Nothing
   End If
ProcExit:
   Exit Sub
 
ErrRtn:
   On Error Resume Next
 
   MsgBox "Error closing ADO Connection", _
      vbCritical, _
      "ADO Error"
 
Resume ProcExit:
End Sub
 
Public Sub ADOOpenRecordSet(ByVal sRecordSet As String)
   If ADO_CONN Is Nothing Then
      MsgBox "You have not establisthed an ADO connection. Use ADOOpenConnection"
      Exit Sub
   End If
 
   Set ADO_RS = CreateObject("ADODB.Recordset")
   ADO_RS.Open sRecordSet, ADO_CONN, adOpenDynamic, adUseClient 'adLockOptimistic
 
End Sub
 
Public Function ADOOpenConnection(ByVal ServerOrFileIn As String, _
   Optional ByVal DBPathIn As String, _
   Optional CommandTypeIn As Long = adCmdStoredProc, _
   Optional CursorLocIn As Long = adUseClient, _
   Optional ByVal UserNameIn As String, _
   Optional ByVal PasswordIn As String) As Boolean
   On Error GoTo ErrRtn
   'gstrChkPt = "On Error": gstrProcName = "ADOOpenConnection"
   Dim sConn            As String
 
   Set ADO_CONN = CreateObject("ADODB.Connection")
   If DBPathIn = vbNullString Then DBPathIn = ServerOrFileIn
 
   With ADO_CONN
      .CursorLocation = CursorLocIn
      sConn = ADOBuildConnStr(ServerOrFileIn, DBPathIn, UserNameIn, PasswordIn)
      .Open sConn
   End With
   
   ADOOpenConnection = True
 
ProcExit:
   Exit Function
 
ErrRtn:
   On Error Resume Next
 
   MsgBox "ADOBuildConnStr:" & vbCrLf & sConn, _
      vbCritical, _
      "Unable to open ADO Connection"
 
Resume ProcExit:
End Function
 
Private Function RetPathOnly(FullPathIn As String) As String
   On Error GoTo ErrRtn
   ' gstrChkPt = "On Error": gstrProcName = "RetPathOnly"
 
   Dim j                As Integer
   j = InStrRev(FullPathIn, "\", , vbTextCompare)
 
   RetPathOnly = Mid$(FullPathIn, 1, j)
 
ProcExit:
   Exit Function
 
ErrRtn:
   ' Call ErrMsg("RetPathOnly", gstrProcName, gstrChkPt, Err.Number, Err.Description, Err.Source)
 
Resume ProcExit:
End Function

Open in new window

0
 
sal21Author Commented:
for mdb tell me... in tis database are reserved data:-)
0
 
danaseamanCommented:
Add Reference to "Microsoft ActiveX Data Objects 2.8 Library"

Following code loads root node (AREA_TERR)  and Child node (SPORTELLI).
Not sure how to get DATI relationship so I didn't add that.


Option Explicit
 
Private Const adUseClient = 3
Private Const adCmdStoredProc = 4
Private Const adOpenForwardOnly = 0
Private Const adLockOptimistic = 3
Private Const adLongVarBinary = 205
Private Const adPersistXML = 1
 
Private ADO_CONN          As Object 'ADODB.Connection
Private ADO_RS            As Object 'ADODB.Recordset
Private ADO_FIELD         As Object 'ADODB.Field
 
 
Private Sub Form_Load()
   Dim cADO             As String
   Dim sValue           As String
   Dim sKey             As String
   Dim nod              As Node
   Dim nod2             As Node
   Dim nod3             As Node
 
   cADO = ADOOpenConnection(App.Path & "\Past_Due_Test.mdb")
   Set ADO_RS = CreateObject("ADODB.Recordset")
 
   With TreeView1
      ADO_RS.Open "Select * from AREA_TERR", ADO_CONN, adOpenDynamic, adUseClient
      ADO_RS.MoveFirst
      Do Until ADO_RS.EOF
         Set ADO_FIELD = ADO_RS.Fields("COD_AREA")
         sValue = ADO_FIELD.Value
         .Nodes.Add , , "K" & sValue, sValue & " - " & ADO_RS.Fields("DESCRIZIONE")
         ADO_RS.MoveNext
      Loop
      ADO_RS.Close
      '
      ADO_RS.Open "Select * from SPORTELLI", ADO_CONN, adOpenDynamic, adUseClient
      ADO_RS.MoveFirst
      Do Until ADO_RS.EOF
         sKey = "K" & ADO_RS.Fields("REGIONE")
         sValue = ADO_RS.Fields("SPORT")
         .Nodes.Add sKey, tvwChild, "L" & sValue, sValue & " - " & ADO_RS.Fields("DESCRIZIONE")
         ADO_RS.MoveNext
      Loop
      ADO_RS.Close
      '
      '
      '
      ADOCloseConnection
   End With
 
End Sub
 
Private Function ADOBuildConnStr(ByVal ServerOrFileIn As String, _
   Optional ByVal DBNameIn As String, _
   Optional ByVal UserNameIn As String, _
   Optional ByVal PasswordIn As String) As String
 
   On Error GoTo ErrRtn
 
 
   ADOBuildConnStr = "Driver={Microsoft Access Driver (*.mdb)};Dbq=" & ServerOrFileIn & _
      ";DefaultDir=" & RetPathOnly(ServerOrFileIn) & ";PWD=" & _
      IIf(LenB(PasswordIn), PasswordIn & ";", ";")
 
ProcExit:
   Exit Function
 
ErrRtn:
   On Error Resume Next
 
   MsgBox "ADOBuildConnStr created was:" & vbCrLf & ADOBuildConnStr, _
      vbCritical, _
      "Invalid ADOBuildConnStr"
 
Resume ProcExit:
End Function
 
Public Sub ADOCloseConnection()
   On Error GoTo ErrRtn
   If Not ADO_CONN Is Nothing Then
      ADO_CONN.Close
      Set ADO_CONN = Nothing
   End If
ProcExit:
   Exit Sub
 
ErrRtn:
   On Error Resume Next
 
   MsgBox "Error closing ADO Connection", _
      vbCritical, _
      "ADO Error"
 
Resume ProcExit:
End Sub
 
Public Sub ADOOpenRecordSet(ByVal sRecordSet As String)
   If ADO_CONN Is Nothing Then
      MsgBox "You have not establisthed an ADO connection. Use ADOOpenConnection"
      Exit Sub
   End If
 
   Set ADO_RS = CreateObject("ADODB.Recordset")
   ADO_RS.Open sRecordSet, ADO_CONN, adOpenDynamic, adUseClient 'adLockOptimistic
 
End Sub
 
Public Function ADOOpenConnection(ByVal ServerOrFileIn As String, _
   Optional ByVal DBPathIn As String, _
   Optional CommandTypeIn As Long = adCmdStoredProc, _
   Optional CursorLocIn As Long = adUseClient, _
   Optional ByVal UserNameIn As String, _
   Optional ByVal PasswordIn As String) As Boolean
   On Error GoTo ErrRtn
   'gstrChkPt = "On Error": gstrProcName = "ADOOpenConnection"
   Dim sConn            As String
 
   Set ADO_CONN = CreateObject("ADODB.Connection")
   If DBPathIn = vbNullString Then DBPathIn = ServerOrFileIn
 
   With ADO_CONN
      .CursorLocation = CursorLocIn
      sConn = ADOBuildConnStr(ServerOrFileIn, DBPathIn, UserNameIn, PasswordIn)
      .Open sConn
   End With
 
ProcExit:
   Exit Function
 
ErrRtn:
   On Error Resume Next
 
   MsgBox "ADOBuildConnStr:" & vbCrLf & sConn, _
      vbCritical, _
      "Unable to open ADO Connection"
 
Resume ProcExit:
End Function
 
Private Function RetPathOnly(FullPathIn As String) As String
   On Error GoTo ErrRtn
   ' gstrChkPt = "On Error": gstrProcName = "RetPathOnly"
 
   Dim j                As Integer
   j = InStrRev(FullPathIn, "\", , vbTextCompare)
 
   RetPathOnly = Mid$(FullPathIn, 1, j)
 
ProcExit:
   Exit Function
 
ErrRtn:
   ' Call ErrMsg("RetPathOnly", gstrProcName, gstrChkPt, Err.Number, Err.Description, Err.Source)
 
Resume ProcExit:
End Function

Open in new window

0
Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

 
sal21Author Commented:
HI danaseaman the code work, but i dont see the rset refered SPORTELLI (if you see the image attached)....
In effect if i click on node 0500 i want to view all related data...

I think you must add another node or not?
Immagine.JPG
0
 
danaseamanCommented:
Yes. I didn't see the relationship in DATI. I am working on updating the code.
0
 
sal21Author Commented:
ahhhhhhhhh... and i dont seet the symbol "+" to expand/unexpand the node, why?
0
 
danaseamanCommented:
I am in process of adding the last node - PROVA1,PROVA3, etc.
It will take a few minutes to finish this part.
0
 
danaseamanCommented:
Try this. Added node for DATI.

Option Explicit
 
Private Const adUseClient = 3
Private Const adCmdStoredProc = 4
Private Const adOpenForwardOnly = 0
Private Const adLockOptimistic = 3
Private Const adLongVarBinary = 205
Private Const adPersistXML = 1
 
Private ADO_CONN          As Object 'ADODB.Connection
Private ADO_RS            As Object 'ADODB.Recordset
Private ADO_FIELD         As Object 'ADODB.Field
 
 
Private Sub Form_Load()
   Dim bOpen            As Boolean
   Dim sValue           As String
   Dim sKey             As String
   Dim sKey2            As String
   Dim nod              As Node
   Dim nod2             As Node
   Dim nod3             As Node
   Dim i                As Long
   
   If Not ADOOpenConnection(App.Path & "\Past_Due_Test.mdb") Then
      Exit Sub
   End If
 
   With TreeView1
      ADOOpenRecordSet "Select * from AREA_TERR"
      ADO_RS.MoveFirst
      Do Until ADO_RS.EOF
         Set ADO_FIELD = ADO_RS.Fields("COD_AREA")
         sValue = ADO_FIELD.Value
         .Nodes.Add , , "K" & sValue, sValue & " - " & ADO_RS.Fields("DESCRIZIONE")
         ADO_RS.MoveNext
      Loop
      ADO_RS.Close
      '
      ADOOpenRecordSet "Select * from SPORTELLI"
      ADO_RS.MoveFirst
      Do Until ADO_RS.EOF
         sKey = "K" & ADO_RS.Fields("REGIONE")
         sValue = ADO_RS.Fields("SPORT")
         .Nodes.Add sKey, tvwChild, "L" & sValue, sValue & " - " & ADO_RS.Fields("DESCRIZIONE")
         ADO_RS.MoveNext
      Loop
      ADO_RS.Close
      '  PROVA2
      ADOOpenRecordSet "Select * from DATI"
      ADO_RS.MoveFirst
      Do Until ADO_RS.EOF
         sKey = "L" & ADO_RS.Fields("PROVA2")
         sValue = ""
         For i = 1 To 8
            If i <> 2 Then
               sKey2 = "PROVA" & i
               sValue = sValue & sKey2 & " = " & ADO_RS.Fields(sKey2)
               If i < 8 Then
                  sValue = sValue & ", "
               End If
            End If
         Next
         .Nodes.Add sKey, tvwChild, "M" & sKey & sValue, sValue
         ADO_RS.MoveNext
      Loop
      ADO_RS.Close
      '
      ADOCloseConnection
   End With
 
End Sub
 
Private Function ADOBuildConnStr(ByVal ServerOrFileIn As String, _
   Optional ByVal DBNameIn As String, _
   Optional ByVal UserNameIn As String, _
   Optional ByVal PasswordIn As String) As String
 
   On Error GoTo ErrRtn
 
 
   ADOBuildConnStr = "Driver={Microsoft Access Driver (*.mdb)};Dbq=" & ServerOrFileIn & _
      ";DefaultDir=" & RetPathOnly(ServerOrFileIn) & ";PWD=" & _
      IIf(LenB(PasswordIn), PasswordIn & ";", ";")
 
ProcExit:
   Exit Function
 
ErrRtn:
   On Error Resume Next
 
   MsgBox "ADOBuildConnStr created was:" & vbCrLf & ADOBuildConnStr, _
      vbCritical, _
      "Invalid ADOBuildConnStr"
 
Resume ProcExit:
End Function
 
Public Sub ADOCloseConnection()
   On Error GoTo ErrRtn
   If Not ADO_CONN Is Nothing Then
      ADO_CONN.Close
      Set ADO_CONN = Nothing
   End If
ProcExit:
   Exit Sub
 
ErrRtn:
   On Error Resume Next
 
   MsgBox "Error closing ADO Connection", _
      vbCritical, _
      "ADO Error"
 
Resume ProcExit:
End Sub
 
Public Sub ADOOpenRecordSet(ByVal sRecordSet As String)
   If ADO_CONN Is Nothing Then
      MsgBox "You have not establisthed an ADO connection. Use ADOOpenConnection"
      Exit Sub
   End If
 
   Set ADO_RS = CreateObject("ADODB.Recordset")
   ADO_RS.Open sRecordSet, ADO_CONN, adOpenDynamic, adUseClient 'adLockOptimistic
 
End Sub
 
Public Function ADOOpenConnection(ByVal ServerOrFileIn As String, _
   Optional ByVal DBPathIn As String, _
   Optional CommandTypeIn As Long = adCmdStoredProc, _
   Optional CursorLocIn As Long = adUseClient, _
   Optional ByVal UserNameIn As String, _
   Optional ByVal PasswordIn As String) As Boolean
   On Error GoTo ErrRtn
   'gstrChkPt = "On Error": gstrProcName = "ADOOpenConnection"
   Dim sConn            As String
 
   Set ADO_CONN = CreateObject("ADODB.Connection")
   If DBPathIn = vbNullString Then DBPathIn = ServerOrFileIn
 
   With ADO_CONN
      .CursorLocation = CursorLocIn
      sConn = ADOBuildConnStr(ServerOrFileIn, DBPathIn, UserNameIn, PasswordIn)
      .Open sConn
   End With
   
   ADOOpenConnection = True
 
ProcExit:
   Exit Function
 
ErrRtn:
   On Error Resume Next
 
   MsgBox "ADOBuildConnStr:" & vbCrLf & sConn, _
      vbCritical, _
      "Unable to open ADO Connection"
 
Resume ProcExit:
End Function
 
Private Function RetPathOnly(FullPathIn As String) As String
   On Error GoTo ErrRtn
   ' gstrChkPt = "On Error": gstrProcName = "RetPathOnly"
 
   Dim j                As Integer
   j = InStrRev(FullPathIn, "\", , vbTextCompare)
 
   RetPathOnly = Mid$(FullPathIn, 1, j)
 
ProcExit:
   Exit Function
 
ErrRtn:
   ' Call ErrMsg("RetPathOnly", gstrProcName, gstrChkPt, Err.Number, Err.Description, Err.Source)
 
Resume ProcExit:
End Function

Open in new window

0
 
sal21Author Commented:
HI danaseaman GOOD!
only one...
Is possible to show in the node only SPORTELLI if have one or more data?
example:
in thsi case show only SPORTELLI 0500, 4500,4501,4502,6500, 6501, not important for me to show other SPORTELLI dont ghave data to view...
In effect make a dinamic fill for SPORTELLI tath have data.
Hope understand me...
Naturally if all work fine the AREA 8501, 8502,8503,8504 not show nothing based my new request  
0
 
sal21Author Commented:
Idea.... if a AREA have data to show about SPORTELLI colored this or use a bold font, wath you think?
0
 
danaseamanCommented:
Updated code. Only Root nodes with children have + sign. Skips children that do not have DATI. Note that it is much slower since it is checking for DATI before adding 1st Level nodes.

Option Explicit
 
Private Const adUseClient = 3
Private Const adCmdStoredProc = 4
Private Const adOpenForwardOnly = 0
Private Const adLockOptimistic = 3
Private Const adLongVarBinary = 205
Private Const adPersistXML = 1
 
Private ADO_CONN          As ADODB.Connection
Private ADO_RS            As ADODB.Recordset
 
Private Sub Form_Load()
   Dim bOpen            As Boolean
   Dim sValue           As String
   Dim sKey             As String
   Dim nod              As Node
   Dim nod2             As Node
   Dim nod3             As Node
   Dim i                As Long
   
   If Not ADOOpenConnection(App.Path & "\Past_Due_Test.mdb") Then
      Exit Sub
   End If
 
   With TreeView1
      ADOOpenRecordSet "Select * from AREA_TERR"
      ADO_RS.MoveFirst
      Do Until ADO_RS.EOF
         sValue = ADO_RS.Fields("COD_AREA").Value
         .Nodes.Add , , "K" & sValue, sValue & " - " & ADO_RS.Fields("DESCRIZIONE")
         ADO_RS.MoveNext
      Loop
      ADO_RS.Close
      '
      ADOOpenRecordSet "Select * from SPORTELLI"
      ADO_RS.MoveFirst
      Do Until ADO_RS.EOF
         sKey = "K" & ADO_RS.Fields("REGIONE")
         sValue = ADO_RS.Fields("SPORT")
         If HasData(sValue) Then
            .Nodes.Add sKey, tvwChild, "L" & sValue, sValue & " - " & ADO_RS.Fields("DESCRIZIONE")
         End If
         ADO_RS.MoveNext
      Loop
      ADO_RS.Close
      '
      ADOOpenRecordSet "Select * from DATI"
      ADO_RS.MoveFirst
      Do Until ADO_RS.EOF
         sKey = "L" & ADO_RS.Fields("PROVA2")
         sValue = ""
         For i = 1 To 8
            If i <> 2 Then
               sValue = sValue & ADO_RS.Fields("PROVA" & i)
               If i < 8 Then
                  sValue = sValue & ", "
               End If
            End If
         Next
         .Nodes.Add sKey, tvwChild, "M" & sKey & sValue, sValue
         .Nodes(sKey).Parent.Bold = True
         ADO_RS.MoveNext
      Loop
      ADO_RS.Close
      ADOCloseConnection
   End With
 
End Sub
 
Private Function HasData(ByVal sValue As String) As Boolean
   Dim ADO_RS       As ADODB.Recordset
   Dim sRecordSet   As String
   
   sRecordSet = "Select * from DATI Where PROVA2 = '" & sValue & "'"
   Set ADO_RS = CreateObject("ADODB.Recordset")
   ADO_RS.Open sRecordSet, ADO_CONN, adOpenDynamic, adUseClient 'adLockOptimistic
   HasData = ADO_RS.RecordCount > 0
   ADO_RS.Close
End Function
 
Private Function ADOBuildConnStr(ByVal ServerOrFileIn As String, _
   Optional ByVal DBNameIn As String, _
   Optional ByVal UserNameIn As String, _
   Optional ByVal PasswordIn As String) As String
 
   On Error GoTo ErrRtn
 
 
   ADOBuildConnStr = "Driver={Microsoft Access Driver (*.mdb)};Dbq=" & ServerOrFileIn & _
      ";DefaultDir=" & RetPathOnly(ServerOrFileIn) & ";PWD=" & _
      IIf(LenB(PasswordIn), PasswordIn & ";", ";")
 
ProcExit:
   Exit Function
 
ErrRtn:
   On Error Resume Next
 
   MsgBox "ADOBuildConnStr created was:" & vbCrLf & ADOBuildConnStr, _
      vbCritical, _
      "Invalid ADOBuildConnStr"
 
Resume ProcExit:
End Function
 
Public Sub ADOCloseConnection()
   On Error GoTo ErrRtn
   If Not ADO_CONN Is Nothing Then
      ADO_CONN.Close
      Set ADO_CONN = Nothing
   End If
ProcExit:
   Exit Sub
 
ErrRtn:
   On Error Resume Next
 
   MsgBox "Error closing ADO Connection", _
      vbCritical, _
      "ADO Error"
 
Resume ProcExit:
End Sub
 
Public Sub ADOOpenRecordSet(ByVal sRecordSet As String)
   If ADO_CONN Is Nothing Then
      MsgBox "You have not establisthed an ADO connection. Use ADOOpenConnection"
      Exit Sub
   End If
 
   Set ADO_RS = CreateObject("ADODB.Recordset")
   ADO_RS.Open sRecordSet, ADO_CONN, adOpenDynamic, adUseClient 'adLockOptimistic
 
End Sub
 
Public Function ADOOpenConnection(ByVal ServerOrFileIn As String, _
   Optional ByVal DBPathIn As String, _
   Optional CommandTypeIn As Long = adCmdStoredProc, _
   Optional CursorLocIn As Long = adUseClient, _
   Optional ByVal UserNameIn As String, _
   Optional ByVal PasswordIn As String) As Boolean
   On Error GoTo ErrRtn
   'gstrChkPt = "On Error": gstrProcName = "ADOOpenConnection"
   Dim sConn            As String
 
   Set ADO_CONN = CreateObject("ADODB.Connection")
   If DBPathIn = vbNullString Then DBPathIn = ServerOrFileIn
 
   With ADO_CONN
      .CursorLocation = CursorLocIn
      sConn = ADOBuildConnStr(ServerOrFileIn, DBPathIn, UserNameIn, PasswordIn)
      .Open sConn
   End With
   
   ADOOpenConnection = True
 
ProcExit:
   Exit Function
 
ErrRtn:
   On Error Resume Next
 
   MsgBox "ADOBuildConnStr:" & vbCrLf & sConn, _
      vbCritical, _
      "Unable to open ADO Connection"
 
Resume ProcExit:
End Function
 
Private Function RetPathOnly(FullPathIn As String) As String
   On Error GoTo ErrRtn
   ' gstrChkPt = "On Error": gstrProcName = "RetPathOnly"
 
   Dim j                As Integer
   j = InStrRev(FullPathIn, "\", , vbTextCompare)
 
   RetPathOnly = Mid$(FullPathIn, 1, j)
 
ProcExit:
   Exit Function
 
ErrRtn:
   ' Call ErrMsg("RetPathOnly", gstrProcName, gstrChkPt, Err.Number, Err.Description, Err.Source)
 
Resume ProcExit:
End Function

Open in new window

0
 
sal21Author Commented:
hI danaseaman (I dont lknow your really name) ia m very happy to give you pts, i ahve understand many and many notice about treeview!!!
But:
How to intecept the click event in nodes or simple when scrool ir with key arrox on keyboard?
Why when passing with mouse on one element of node SPORTELLI i see a tooltip text?

If you have time send me your e mail to change a words ;-) gss_dot_italy_at_iol_dot_it
I live in Italy, in Napoli you know thgis City?
Virtual Pizza an spaghetti for you.
Sal.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.