VBA/Excel/Access/Word/Access/Recordset Filter
Версия от 16:33, 26 мая 2010; (обсуждение)
Содержание
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