Slow DAO and ADO in treeview 1

[perrymans]

I am building a treeview using DAO, and because there are many levels and many records, it is taking sometime (~5-10 seconds). I switched to ADO to se if there would be a performance boost and there was not.

My guess is that the fault lies not with ADO, but rather my opening and closing of the ADODB>Recordset everytime. Below is my code, please let me know if I am missing a key thing when working with ADO.

Thanks. Sean.

Function tvwFillTree(strQuery1, strQuery2, strQuery3, strQuery4, strQuery5 As String)

On Error GoTo ErrorHandler

   Dim strMessage As String
   Dim db As String
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset
   Dim intVBMsg As Integer
   Dim nod As Object
   Dim strNode1Text As String
   Dim strNode2Text As String
   Dim strVisibleText1 As String
   Dim strVisibleText2 As String
   Dim ctltree As Control
   'Dim NodeA As Node
   Dim objImageList As Object
   
   'Compose the database name
   db = CurrentProject.Path & "\Raytheon Cost.mdb"
      
   'Connect to the database
   Set conn = New ADODB.Connection
   conn.Mode = adModeRead
   conn.ConnectionString = _
    "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & db
    conn.Open
   
   
   Set ctltree = Me.TV1
   Set objImageList = Me.IL1
   ctltree.ImageList = objImageList.Object
   ctltree.SetFocus
   ctltree.Nodes.Clear
   
    Set rst = New ADODB.Recordset
    Set rst.ActiveConnection = conn
    rst.CursorType = adOpenDynamic
    rst.Source = strQuery1
    rst.LockType = adLockOptimistic
    rst.Open
    
    If rst.RecordCount = 0 Then
        rst.Close
        Set rst = Nothing
        GoTo ErrorHandlerExit
    End If
   
   
   With ctltree
      'Fill Level 1
        'Set rst = New ADODB.Recordset
        'Set rst.ActiveConnection = conn
        'rst.CursorType = adOpenDynamic
        'rst.Source = strQuery1
        'rst.LockType = adLockOptimistic
        'rst.Open

      'Add a node object for each record in the first table/query.
      'For parent nodes, the Key property is based on the the level of the tree
      'in which the node exists and the Link Master field(s) you selected when
      'linking levels in the wizard.  For child nodes, the Relative property
      'is based on the level of the tree in which the Parent node exists and
      'the Link Child field(s) you selected when linking levels in the wizard.

      Do Until rst.EOF
         Debug.Print "Adding Level 1 item: " & rst![Parent]
         strNode1Text = StrConv("Level1 -" & rst![Parent], _
            vbLowerCase)
         Debug.Print "Node 1 text: " & strNode1Text
         strVisibleText1 = "PO: " & rst![ParentName]
         Debug.Print "Level 1 visible text: " & strVisibleText1
         Set nod = .Nodes.Add(Key:=strNode1Text, _
            Text:=strVisibleText1, Image:="Closed")
         nod.Expanded = False
         rst.MoveNext
      Loop
      rst.Close
      
      'Fill Level 2
        Set rst = New ADODB.Recordset
        Set rst.ActiveConnection = conn
        rst.CursorType = adOpenDynamic
        rst.Source = strQuery2
        rst.LockType = adLockOptimistic
        rst.Open

      Do Until rst.EOF
         Debug.Print "Adding Level 2 item: " & rst![Child]
         strNode1Text = StrConv("Level1 -" & rst![Parent], vbLowerCase)
         Debug.Print "Node 1 text: "; strNode1Text
         strNode2Text = StrConv("Level2 -" & rst![ChildKey], vbLowerCase) '& " =" _
            & rst![Child], vbLowerCase)
         Debug.Print "Node 2 text: " & strNode2Text
         strVisibleText2 = "DO: " & rst![Child]
         Debug.Print "Visible text: " & strVisibleText2
         .Nodes.Add relative:=strNode1Text, _
            relationship:=tvwChild, _
            Key:=strNode2Text, _
            Text:=strVisibleText2, Image:="Case"
         rst.MoveNext
      Loop
      rst.Close
      
       'Fill Level 3
        Set rst = New ADODB.Recordset
        Set rst.ActiveConnection = conn
        rst.CursorType = adOpenDynamic
        rst.Source = strQuery3
        rst.LockType = adLockOptimistic
        rst.Open

      Do Until rst.EOF
         Debug.Print "Adding Level 3 item: " & rst![Child]
         strNode1Text = StrConv("Level2 -" & rst![Parent], vbLowerCase)
         Debug.Print "Node 1 text: "; strNode1Text
         strNode2Text = StrConv("Level3 -" & rst![ChildKey], vbLowerCase) '& " =" _
            & rst![Child], vbLowerCase)
         Debug.Print "Node 2 text: " & strNode2Text
         strVisibleText2 = "Ship: " & rst![Child]
         Debug.Print "Visible text: " & strVisibleText2
         .Nodes.Add relative:=strNode1Text, _
            relationship:=tvwChild, _
            Key:=strNode2Text, _
            Text:=strVisibleText2, Image:="Ship"
         rst.MoveNext
      Loop
      rst.Close
    
       'Fill Level 4
        Set rst = New ADODB.Recordset
        Set rst.ActiveConnection = conn
        rst.CursorType = adOpenDynamic
        rst.Source = strQuery4
        rst.LockType = adLockOptimistic
        rst.Open

      Do Until rst.EOF
         Debug.Print "Adding Level 4 item: " & rst![Child]
         strNode1Text = StrConv("Level3 -" & rst![Parent], vbLowerCase)
         Debug.Print "Node 1 text: "; strNode1Text
         strNode2Text = StrConv("Level4 -" & rst![ChildKey], vbLowerCase) '& " =" _
            & rst![Child], vbLowerCase)
         Debug.Print "Node 2 text: " & strNode2Text
         strVisibleText2 = "Task: " & rst![Child]
         Debug.Print "Visible text: " & strVisibleText2
         .Nodes.Add relative:=strNode1Text, _
            relationship:=tvwChild, _
            Key:=strNode2Text, _
            Text:=strVisibleText2, Image:="Task"
         rst.MoveNext
      Loop
      rst.Close
      
       'Fill Level 5
        Set rst = New ADODB.Recordset
        Set rst.ActiveConnection = conn
        rst.CursorType = adOpenDynamic
        rst.Source = strQuery5
        rst.LockType = adLockOptimistic
        rst.Open

      Do Until rst.EOF
         Debug.Print "Adding Level 5 item: " & rst![Child]
         strNode1Text = StrConv("Level4 -" & rst![Parent], vbLowerCase)
         Debug.Print "Node 1 text: "; strNode1Text
         strNode2Text = StrConv("Level5 -" & rst![ChildKey], vbLowerCase) '& " ="
            '& rst![Parent], vbLowerCase)
         Debug.Print "Node 2 text: " & strNode2Text
         strVisibleText2 = rst![Child]
         Debug.Print "Visible text: " & strVisibleText2
         .Nodes.Add relative:=strNode1Text, _
            relationship:=tvwChild, _
            Key:=strNode2Text, _
            Text:=strVisibleText2, Image:="Clock"
         rst.MoveNext
      Loop
      rst.Close
      
   End With
   conn.Close

ErrorHandlerExit:
   Exit Function

ErrorHandler:
   Select Case Err.Number
      Case 35601
         'Element not found
         strMessage = "Possible Causes: You selected a table/query" _
            & " for a child level which does not correspond to a value" _
            & " from its parent level."
         intVBMsg = MsgBox(Error$ & strMessage, vbOKOnly + _
            vbExclamation, "Run-time Error: " & Err.Number)
      Case 35602
         'Key is not unique in collection
         strMessage = "Possible Causes: You entered a duplicate Part Number," _
            & " but used a Part Name different than similar parts."
         intVBMsg = MsgBox(strMessage, vbOKOnly + _
            vbExclamation, "Run-time Error: " & Err.Number & "  " & Error$)
      Case Else
         intVBMsg = MsgBox(Error$ & "@@", vbOKOnly + _
            vbExclamation, "Run-time Error: " & Err.Number)
   End Select
   Resume ErrorHandlerExit

End Function

 

[perrymans]

Found one! I just cut it down from 16 seconds to 3 seconds. Just used the MSDN sample at:

http://support.microsoft.com/?kbid=209927

Here is the new code:

Private Sub FillTreeFool(strQuery1, strQuery2, strQuery3, strQuery4, strQuery5 As String)

    Dim CN As ADODB.Connection, RS As ADODB.Recordset
    Dim strNodeKey, strVisibleText, strParentKey As String
    Dim ctltree As Control, objImageList As Object


    Set CN = CurrentProject.Connection
    Set RS = New ADODB.Recordset

    Set ctltree = Me.TV1
    Set objImageList = Me.IL1
    ctltree.ImageList = objImageList.Object
    ctltree.SetFocus
    ctltree.Nodes.Clear

    ' Open a recordset and loop through it to fill the Treeview Control
    ' Fill Level 1 using Parent as Key property, already alphabetical
    RS.Open strQuery1, CN, adOpenForwardOnly
    Do Until RS.EOF
        strNodeKey = StrConv("Level1 -" & RS![Parent], vbLowerCase)
        strVisibleText = "PO: " & RS![ParentName]
        ctltree.Nodes.Add , , strNodeKey, strVisibleText, "Closed"
        RS.MoveNext
    Loop
    RS.Close

    ' Fill Level 2
    RS.Open strQuery2, CN, adOpenForwardOnly
    Do Until RS.EOF

         strParentKey = StrConv("Level1 -" & RS![Parent], vbLowerCase)
         strNodeKey = StrConv("Level2 -" & RS![ChildKey], vbLowerCase) '& " =" _
            & RS![Child], vbLowerCase)
         strVisibleText = "DO: " & RS![Child]
        ctltree.Nodes.Add strParentKey, tvwChild, strNodeKey, strVisibleText, "Case"
        RS.MoveNext
    Loop
    RS.Close

    ' Fill level 3
    RS.Open strQuery3, CN, adOpenForwardOnly
    Do Until RS.EOF

         strParentKey = StrConv("Level2 -" & RS![Parent], vbLowerCase)
         strNodeKey = StrConv("Level3 -" & RS![ChildKey], vbLowerCase) '& " =" _
            & RS![Child], vbLowerCase)
         strVisibleText = "Ship: " & RS![Child]
        ctltree.Nodes.Add strParentKey, tvwChild, strNodeKey, strVisibleText, "Ship"
        RS.MoveNext
    Loop
    RS.Close

    ' Fill level 4
    RS.Open strQuery4, CN, adOpenForwardOnly
    Do Until RS.EOF

         strParentKey = StrConv("Level3 -" & RS![Parent], vbLowerCase)
         strNodeKey = StrConv("Level4 -" & RS![ChildKey], vbLowerCase) '& " =" _
            & RS![Child], vbLowerCase)
         strVisibleText = "Task: " & RS![Child]
        ctltree.Nodes.Add strParentKey, tvwChild, strNodeKey, strVisibleText, "Task"
        RS.MoveNext
    Loop
    RS.Close

    ' Fill level 5
    RS.Open strQuery5, CN, adOpenForwardOnly
    Do Until RS.EOF
         
         strParentKey = StrConv("Level4 -" & RS![Parent], vbLowerCase)
         strNodeKey = StrConv("Level5 -" & RS![ChildKey], vbLowerCase) '& " ="
            '& RS![Parent], vbLowerCase)
         strVisibleText = RS![Child]
        ctltree.Nodes.Add strParentKey, tvwChild, strNodeKey, strVisibleText, "Clock"
        RS.MoveNext
    Loop
    RS.Close

    CN.Close
    Set RS = Nothing
    Set CN = Nothing

End Sub

 

[markphsd]

If you didn't notice, you are using a forward only recordset, instead of the static record set. Forward only is the fastest recordset. You

the only reason to use the adopenstatic is to get the record count, and be able to move forward and backward (same as abopendynamic, but with no count).
In your case you were using it to check if there were no records. You should use

if rs.eof or rs.bof then
set rst = nothing
set con = nothing
exit function
end if

you should also identify the recordset as readonly, this will further increase speed

rs.Open sSQL, cnn, adOpenForwardonly, adLockReadOnly

Mark P.

http://www.cafecartel.com

Providing Low Cost Powerful Point of Sale Solutions.