HOWTO: Find a Record Using Complex Criteria with ADO

ID: Q245408

The information in this article applies to:

ActiveX Data Objects (ADO), versions 2.0, 2.1, 2.5
Microsoft Visual Basic Professional and Enterprise Editions for Windows, versions 5.0, 6.0

SUMMARY

This article details a method to work around limitations of the ADO Recordset Find method. Functionality provided in the following custom written class includes the ability to search on multiple fields, text literals containing quotes, and complex expressions.

MORE INFORMATION

The ADO Recordset Find method has a number of limitations:

Only allows searching a single field.

Does not allow quotes in text literals.

Does not allow searching on expressions.

One way to work around this problem is to use the Filter property. This allows the use of text literals that contain quotes, however, this is limited. It also allows the ability to perform searches on more than one field, though the types of expression is limited as well. These limitations are due to the ADO Client Cursor Engine not containing a full expression parser.

This article provides a generic class and application to demonstrate how to use the underlying SQL database engine to parse complex expressions and enable the application to locate the desired record.

The class performs the following tasks:

Queries the provider for the Primary Key value using the complex criteria.
Uses the Primary key value returned to Find the record in the local cache.
Manages FindFirst, FindLast, FindNext, and FindPrevious functionality.

The class has the following requirements:

The Recordset must use a client-side cursor.
The Primary Key must consist of a single field.
The Criteria must be written in syntax the provider understands.

Examples of Complex Find Criteria

These are some complex criteria that cannot be handled by Find or Filter. In addition, if you have a Grid bound to the Recordset, you will not be able to use the Filter property to locate a record without altering the Grid display. This limits the searchable expressions even more.

(Field1 + Field2) < 5000
FieldX In (1,2,3) AND FieldY In ("A","B","C")
FieldX In (SELECT ID FROM Table2)
Description = "#3 Board 4" '"2' x 2''4"'

The MultiFind Class

The MultiFind class is a generic class designed to handle complex Find expressions using multiple fields. Initialization consists of setting three properties and calling one method. Once this is complete, you can call the Find methods.


Dim MFind As MultiFind
Set MFind = New MultiFind
Set MFind.RecordSource = rs
Set MFind.Connect = cn
MFind.SQLPrefix = "SELECT * FROM TestFind WHERE"
MFind.PrimaryKey "ID", mfNumeric

The RecordSource property is the Recordset the MultiFind class will manage.
The Connect property is either a connection object or a connect string to the provider and the database the RecordSource is based on. If you omit this property, it uses the ActiveConnection property of the RecordSource.
SQLPrefix is the SELECT statement which forms the basis for the Find. If the RecordSource contains the entire table, then the SQLPrefix should consist of:
```
SELECT * FROM <tablename> WHERE 
```
If the RecordSource contains a portion of the table, then the SQLPrefix should consist of:
```
SELECT * FROM <tablename> WHERE (<criteria>) AND 
```
The <tablename> can be a JOIN expression.
The PrimaryKey method lets the MultiFind class know the name and data type of the primary key field.

The Find methods can be called as follows:


Dim Found As Boolean
Found = MFind.FindFirst("IMod43=5 AND IMod67=17")
Do While Found
  ' process record
  Found = MFind.FindNext
Loop

The class code consists of the following:


Option Explicit

Public Enum mfFieldType
  mfNumeric = 1
  mfDate
  mdText
End Enum

Dim rsTemp As ADODB.Recordset
Dim rsUser As ADODB.Recordset
Dim mSQLPrefix As String, PKFieldName As String
Dim mType As mfFieldType, mConnect As Variant

Public Property Set RecordSource(NewVal As ADODB.Recordset)
  If NewVal.CursorLocation <> adUseClient Then
    Err.Raise 911, "MultiFind", "Recordset must use client-side cursors"
  Else
    Set rsUser = NewVal
    Set mConnect = rsUser.ActiveConnection
  End If
End Property

Public Property Let Connect(ByVal NewVal As String)
  mConnect = NewVal
End Property

Public Property Set Connect(NewVal As ADODB.Connection)
  Set mConnect = NewVal
End Property

Public Property Let SQLPrefix(ByVal NewVal As String)
'
' Prefix must end with "WHERE" or "AND"
'
' If rsUser is opened on SELECT * FROM Table1, use this prefix:
'    SELECT ID FROM Table1 WHERE
'
' If rsUser is opened on SELECT * FROM Table1 WHERE Status = 5, then use this prefix:
'    SELECT ID FROM Table1 WHERE Status = 5 AND
'
  mSQLPrefix = NewVal
End Property

Public Sub PrimaryKey(ByVal FieldName As String, ByVal FieldType As mfFieldType)
  rsUser(FieldName).Properties("Optimize") = True
  PKFieldName = FieldName
  mType = FieldType
End Sub

Public Function FindFirst(ByVal Criteria As String) As Boolean
Dim BookMark As Variant
  If rsUser.EOF And rsUser.BOF Then Exit Function
  FindInit Criteria
  If rsTemp.EOF Then
    FindFirst = False
  Else
    If Not rsUser.EOF And Not rsUser.BOF Then BookMark = rsUser.BookMark
    If mType = mfNumeric Then
      rsUser.Find PKFieldName & "=" & rsTemp(0).Value
    Else   ' date and text use ' delimiter
      rsUser.Find PKFieldName & "='" & rsTemp(0).Value & "'"
    End If
    FindFirst = Not rsUser.EOF And Not rsUser.BOF
    If Not FindFirst And Not IsNull(BookMark) Then rsUser.BookMark = BookMark
  End If
End Function

Public Function FindLast(ByVal Criteria As String) As Boolean
Dim BookMark As Variant
  If rsUser.EOF And rsUser.BOF Then Exit Function
  FindInit Criteria
  If rsTemp.EOF Then
    FindLast = False
  Else
    rsTemp.MoveLast
    If Not rsUser.EOF And Not rsUser.BOF Then BookMark = rsUser.BookMark
    If mType = mfNumeric Then
      rsUser.Find PKFieldName & "=" & rsTemp(0).Value
    Else   ' date and text use ' delimiter
      rsUser.Find PKFieldName & "='" & rsTemp(0).Value & "'"
    End If
    FindFirst = Not rsUser.EOF And Not rsUser.BOF
    If Not FindFirst And Not IsNull(BookMark) Then rsUser.BookMark = BookMark
  End If
End Function

Public Function FindNext() As Boolean
Dim BookMark As Variant
  If rsUser.EOF And rsUser.BOF Then Exit Function
  If rsTemp Is Nothing Then Exit Function
  If rsTemp.State = 0 Then Exit Function
  If rsTemp.EOF Then Exit Function
  rsTemp.MoveNext
  If rsTemp.EOF Then Exit Function
  If Not rsUser.EOF And Not rsUser.BOF Then BookMark = rsUser.BookMark
  If mType = mfNumeric Then
    rsUser.Find PKFieldName & "=" & rsTemp(0).Value
  Else   ' date and text use ' delimiter
    rsUser.Find PKFieldName & "='" & rsTemp(0).Value & "'"
  End If
  FindNext = Not rsUser.EOF And Not rsUser.BOF
  If Not FindNext And Not IsNull(BookMark) Then rsUser.BookMark = BookMark
End Function

Public Function MovePrevious() As Boolean
Dim BookMark As Variant
  If rsUser.EOF And rsUser.BOF Then Exit Function
  If rsTemp Is Nothing Then Exit Function
  If rsTemp.State = 0 Then Exit Function
  If rsTemp.BOF Then Exit Function
  rsTemp.MovePrevious
  If rsTemp.BOF Then Exit Function
  If Not rsUser.EOF And Not rsUser.BOF Then BookMark = rsUser.BookMark
  If mType = mfNumeric Then
    rsUser.Find PKFieldName & "=" & rsTemp(0).Value
  Else   ' date and text use ' delimiter
    rsUser.Find PKFieldName & "='" & rsTemp(0).Value & "'"
  End If
  FindPrevious = Not rsUser.EOF And Not rsUser.BOF
  If Not FindPrevious And Not IsNull(BookMark) Then rsUser.BookMark = BookMark
End Function

Private Sub FindInit(Criteria As String)
  If Not (rsTemp Is Nothing) Then
    If rsTemp.State <> 0 Then
      rsTemp.Close
    End If
  End If
  Set rsTemp = New ADODB.Recordset
  rsTemp.CursorLocation = adUseClient
  rsTemp.Open mSQLPrefix & " (" & Criteria & ")", mConnect, adOpenStatic, adLockReadOnly, adCmdText
End Sub

Private Sub Class_Terminate()
  mConnect = Empty
  Set rsUser = Nothing
  If rsTemp Is Nothing Then Exit Sub
  If rsTemp.State <> 0 Then rsTemp.Close
  Set rsTemp = Nothing
End Sub

NOTES:

If the search succeeds, the class attempts to position your recordset based on the primary key value.

If the search returns a primary key value that is not in your recordset, it will be set to EOF when the ADO Find method fails. The class uses the Bookmark property to locate the original record. You can avoid this problem by making sure that the SQLPrefix is set appropriately.

If the search fails, then the class leaves the recordset on the original record.

Optimizations

The MultiFind class is written to take advantage of indexed fields in the back-end data source to perform an optimized search. It also uses the Optimize property on the primary key field of the cached data so that it can locate the record quickly through the primary key value.

Test Harness

The following test program creates a sample table of 50,000 records, populates it, and performs a complex find against it.

In Microsoft Visual Basic 5 or 6, from the Project menu select References to add a reference to the following type library:

Microsoft ActiveX Data Objects 2.1 Library

Create a new class module (Name=MultiFind) and add the MultiFind code given earlier in the article.

Add two command buttons (name the buttons cmdRun and cmdCreateTable) to the default form.

Add the following code to the Form Module:


Option Explicit

Private Sub cmdCreateTable_Click()
Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim I As Long
  Set cn = New ADODB.Connection
  Set rs = New ADODB.Recordset
  cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=nwind.mdb"
  cn.Execute "CREATE TABLE TestFind (ID INT PRIMARY KEY, " & _
             "Filler Text(30), IMod43 INT, IMod67 INT)"
  rs.CursorLocation = adUseServer
  rs.Open "TestFind", cn, adOpenDynamic, adLockOptimistic, adCmdTable
  For I = 1 To 50000
    rs.AddNew
      rs(0) = I
      rs(1) = "123456789012345678901234567890"
      rs(2) = I Mod 43
      rs(3) = I Mod 67
    rs.Update
  Next I
  rs.Close
  Debug.Print "Creating indices"
  cn.Execute "CREATE INDEX X1 ON TestFind (IMod43)"
  cn.Execute "CREATE INDEX X2 ON TestFind (IMod67)"
  cn.Close
End Sub

Private Sub cmdRun_Click()
Dim cn As ADODB.Connection, rs As ADODB.Recordset, MFind As MultiFind
Dim I As Long, StartTime As Date, EndTime As Date, Found As Boolean
  Set cn = New ADODB.Connection
  Set rs = New ADODB.Recordset
  cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=nwind.mdb"
  rs.CursorLocation = adUseClient
  rs.Open "TestFind", cn, adOpenDynamic, adLockReadOnly, adCmdTable
  Set MFind = New MultiFind
  Set MFind.RecordSource = rs
  Set MFind.Connect = cn
  MFind.SQLPrefix = "SELECT * FROM TestFind WHERE"
  MFind.PrimaryKey "ID", mfNumeric
  StartTime = Time
  Found = MFind.FindFirst("(IMod43/17) = (IMod67/23)")
  Do While Found
    Debug.Print "Found"; rs(0); rs(2), rs(3)
    Found = MFind.FindNext
  Loop
  EndTime = Time
  Debug.Print "Elapsed Time: "; Format$(EndTime - StartTime, "hh:mm:ss")
  rs.Close
  cn.Close
End Sub

Run the application. The output should appear as follows:


Found 1453  34               46 
Found 2167  17               23 
Found 2881  0                0 
Found 4334  34               46 
Found 5048  17               23 
...

Additional query words:

Keywords : kbADO kbADO200 kbVBp500 kbVBp600 kbGrpVBDB kbGrpMDAC kbDSupport kbADO210sp2 kbADO250
Version : WINDOWS:2.0,2.1,2.5,5.0,6.0
Platform : WINDOWS
Issue type : kbhowto