CODEWITHSUNDEEP
sql-servervb6
Nick Nack
Nick Nack

Reputation: 511

Most efficient way to find record in ADO Recordset with multiple criteria? (VB6)

I am converting some old legacy Access code to SQL for our legacy program in which we create a report based on thousands of records worth of data. We use multiple recordsets to access varying records/tables. Previously (in access), we found the desired records in the recordset(s) using the Recordset.Seek function. Doing this gets us the data we want in a manner of seconds.

In converting this to work with SQL using the ADO Recordset instead of DAO, I found that most people recommended simply setting the recordset equal to a new recordset using a query that would return the desired records. This has been the most efficient way to do this so far, but this still takes up to 2 minutes to get the same data that took seconds in access.

I see that the ADO Recordset has a .seek function as well, but I am having trouble attempting to implement this to compare speed/accuracy. If this would be a better method, how do I create/set the Index of the recordset, and how do I know the name of the index?

Thank you!

Upvotes: 0

Views: 2939

Answers (1)

wqw
wqw

Reputation: 11991

You can use Seek only with server-side recordsets from JET OLEDB provider. You can test if Seek is available on a recordset with something like rs.Supports(adSeek).

What I usually do with client-side recordsets is to build in-memory indexes "by hand" with a function like this:

Public Function InitIndexCollection( _
            rs As Recordset, _
            sFld As String, _
            Optional Fld2 As String, _
            Optional Fld3 As String, _
            Optional ByVal HasDuplicates As Boolean, _
            Optional RetVal As Collection) As Collection
    Const FUNC_NAME     As String = "InitIndexCollection"
    Dim oFld            As ADODB.Field
    Dim oFld2           As ADODB.Field
    Dim oFld3           As ADODB.Field
    Dim vBmk            As Variant
    Dim pCol            As Collection '-- IVbCollection that doesn't raise duplicate error on Add

    Set RetVal = New Collection
    With rs
        If .RecordCount > 0 Then
            On Error Resume Next
            vBmk = rs.Bookmark
            On Error GoTo 0
            .MoveFirst
            Set oFld = .Fields(sFld)
            If LenB(Fld2) <> 0 Then
                Set oFld2 = .Fields(Fld2)
            End If
            If LenB(Fld3) <> 0 Then
                Set oFld3 = .Fields(Fld3)
            End If
            If HasDuplicates Then
                On Error Resume Next
                Set pCol = RetVal
                If oFld2 Is Nothing Then
                    Do
                        pCol.Add .Bookmark, CStr(oFld.Value)
                        .MoveNext
                    Loop While Not .EOF
                ElseIf oFld3 Is Nothing Then
                    Do
                        pCol.Add .Bookmark, CStr(oFld.Value) & "#" & CStr(oFld2.Value)
                        .MoveNext
                    Loop While Not .EOF
                Else
                    Do
                        pCol.Add .Bookmark, CStr(oFld.Value) & "#" & CStr(oFld2.Value) & "#" & CStr(oFld3.Value)
                        .MoveNext
                    Loop While Not .EOF
                End If
                On Error GoTo 0
            Else
                If oFld2 Is Nothing Then
                    Do
                        RetVal.Add .Bookmark, CStr(oFld.Value)
                        .MoveNext
                    Loop While Not .EOF
                ElseIf oFld3 Is Nothing Then
                    Do
                        RetVal.Add .Bookmark, CStr(oFld.Value) & "#" & CStr(oFld2.Value)
                        .MoveNext
                    Loop While Not .EOF
                Else
                    Do
                        RetVal.Add .Bookmark, CStr(oFld.Value) & "#" & CStr(oFld2.Value) & "#" & CStr(oFld3.Value)
                        .MoveNext
                    Loop While Not .EOF
                End If
            End If
            If Not IsEmpty(vBmk) Then
                .Bookmark = vBmk
            End If
        End If
    End With
    Set InitIndexCollection = RetVal
End Function

Then you can seek with Bookmark property fast like this

Dim rsItems         As Recordset
Dim cIndex          As Collection

Set cIndex = InitIndexCollection(rsItems, "Code")
...
'--- loop on other rs'
Do While Not rs.EOF
    ...
    rsItems.Bookmark = cIndex(rs!ItemCode.Value) '--- this is seek'
    ...
    rs.MoveNext
Loop

Upvotes: 3

Related Questions