VBA/Excel/Access/Word/Access/Recordset Filter

Материал из VB Эксперт
Перейти к: навигация, поиск

Filtering a Recordset

 
Sub FilterRecordset()
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenKeyset
    rst.LockType = adLockOptimistic
    rst.Open "Select * from Employees"
    Debug.Print "Without Filter"
    Do Until rst.EOF
        Debug.Print rst("BirthDate")
        rst.MoveNext
    Loop
    rst.Filter = "BirthDate >= #1/1/1977# and BirthDate <= #1/5/2007#"
    Debug.Print "With Filter"
    Do Until rst.EOF
        Debug.Print rst("BirthDate")
        rst.MoveNext
    Loop
    rst.Close
    Set rst = Nothing
End Sub



Filtering a Recordset by using the Date type field

 
Sub FilterRecordset()
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenKeyset
    rst.LockType = adLockOptimistic
    rst.Open "Select * from Employees"
    Debug.Print "Without Filter"
    Do Until rst.EOF
        Debug.Print rst("BirthDate")
        rst.MoveNext
    Loop
    rst.Filter = "BirthDate >= #1/1/1977# and BirthDate <= #1/5/2007#"
    Debug.Print "With Filter"
    Do Until rst.EOF
        Debug.Print rst("BirthDate")
        rst.MoveNext
    Loop
    rst.Close
    Set rst = Nothing
End Sub



Filtering Records Using the Filter Property

 
"In the Code window, enter the FltrRecords procedure as shown below.
Sub FltrRecords()
   Dim conn As ADODB.Connection
   Dim myRecordset As ADODB.Recordset
   Set conn = New ADODB.Connection
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\mydb.mdb"
   Set myRecordset = New ADODB.Recordset
   With myRecordset
      .Open "Customers", conn, adOpenKeyset, adLockOptimistic
      .Filter = "City="Madrid" and Country="Spain""
   End With
   myRecordset.Filter = adFilterNone
   MsgBox "Filter was removed. The table contains " & myRecordset.RecordCount & " records."
   myRecordset.Close
   Set myRecordset = Nothing
   conn.Close
   Set conn = Nothing
End Sub



Filtering Records with an SQL Clause

 
Sub GetRecords_WithSQLWhere()
   Dim conn As ADODB.Connection
   Dim myRecordset As ADODB.Recordset
   Dim strSQL As String
   strSQL = "Select * from Employees Where IsNull(Region) OR TitleOfCourtesy = "Mrs." "
   Set conn = New ADODB.Connection
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\mydb.mdb"
   Set myRecordset = New ADODB.Recordset
   myRecordset.Open strSQL, conn, adOpenKeyset, adLockOptimistic
   MsgBox "Selected " & myRecordset.RecordCount & " records."
   myRecordset.Close
   Set myRecordset = Nothing
   conn.Close
   Set conn = Nothing
End Sub



Get result set by column name

 
Sub MyFirstConnection()
    Dim myConnection As ADODB.Connection
    Dim myRecordset As ADODB.Recordset
    Dim strSQL As String
    
    strSQL = "SELECT * FROM Employees ORDER BY LastName"
    
    Set myConnection = CurrentProject.Connection
    
    Set myRecordset = New ADODB.Recordset
    myRecordset.Open strSQL, myConnection
    
    Do Until myRecordset.EOF
       Debug.Print myRecordset.Fields("FirstName"), _
                   myRecordset.Fields("LastName")
       myRecordset.MoveNext
    Loop
    myRecordset.Close
    myConnection.Close
    Set myConnection = Nothing
    Set myRecordset = Nothing
End Sub



Get the number of recorders which meet the criteria

 
"
Sub recordCountCriteria()
   Dim conn As ADODB.Connection
   Dim myRecordset As ADODB.Recordset
   Set conn = New ADODB.Connection
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\mydb.mdb"
   Set myRecordset = New ADODB.Recordset
   With myRecordset
      .Open "Customers", conn, adOpenKeyset, adLockOptimistic
      .Filter = "City="Madrid" and Country="Spain""
      MsgBox .RecordCount & " records meet the criteria.", _
          vbInformation, "Customers in Madrid (Spain)"
   End With
   myRecordset.Close
   Set myRecordset = Nothing
   conn.Close
   Set conn = Nothing
End Sub



Use Recordset filter

 
Sub TestFilter()
    Dim rsContacts As ADODB.Recordset
    Set rsContacts = New ADODB.Recordset
    With rsContacts
        .CursorType = adOpenStatic
        .Open "tblContacts", CurrentProject.Connection
    End With
    rsContacts.Filter = "txtLastName Like "D*""
    If rsContacts.EOF Then
        Debug.Print "No records met that criteria."
    Else
        Do Until rsContacts.EOF
            Debug.Print "Contact Id: " & rsContacts!intContactId & _
                "  Last Name: " & rsContacts!txtLastName & _
                "  First Name: " & rsContacts!txtFirstName
            rsContacts.MoveNext
        Loop
    End If
    rsContacts.Close
    Set rsContacts = Nothing
End Sub