VBA/Excel/Access/Word/Access/Recordset Find

Материал из VB Эксперт

Перейти к: навигация, поиск

Содержание

Change column data case

 
Sub exaRecordsetEdit()
    Dim db As Database
    Dim rs As Recordset
 
    Set db = CurrentDb
    Set rs = db.OpenRecordset("Employees")
 
    rs.MoveFirst
    Do While Not rs.EOF
       rs.Edit
       rs!Title = UCase$(rs!Title)
       rs.Update
       rs.MoveNext
    Loop
 
    rs.Close
 
End Sub



Finding a Record Based on Multiple Criteria

 
Sub Find_WithFilter()
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset
   Set conn = New ADODB.Connection
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & _
      "\mydb.mdb"
   Set rst = New ADODB.Recordset
   rst.Open "Employees", conn, adOpenKeyset, adLockOptimistic
   rst.Filter = "TitleOfCourtesy ="Ms." and Country ="USA""
   Do Until rst.EOF
      Debug.Print rst.Fields("LastName").Value
      rst.MoveNext
   Loop
   rst.Close
   Set rst = Nothing
   conn.Close
   Set conn = Nothing
End Sub



Finding a Specific Record in a Recordset

 
Sub FindProject()
    Dim strSQL As String
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenStatic
    rst.Open "Select * from Employees"
    "Attempt to find a specific project
    strSQL = "[EmployeeID] = " & 1
    rst.Find strSQL
    "Determine if the specified project was found
    If rst.EOF Then
        msgBox lngValue & " Not Found"
    Else
        msgBox lngValue & " Found"
    End If
    rst.Close
    Set rst = Nothing
End Sub



Finding Records Using the Find Method

 
Sub Find_WithFind()
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset
   Set conn = New ADODB.Connection
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\mydb.mdb"
   Set rst = New ADODB.Recordset
   rst.Open "Employees", conn, adOpenKeyset, adLockOptimistic
   rst.Find "TitleOfCourtesy ="Ms.""
   Do Until rst.EOF
      Debug.Print rst.Fields("LastName").Value
      rst.Find "TitleOfCourtesy ="Ms."", SkipRecords:=1, _
          SearchDirection:=adSearchForward
   Loop
   rst.Close
   Set rst = Nothing
   conn.Close
   Set conn = Nothing
End Sub



Finding the Record Position

 
Sub FindRecordPosition()
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset
   Dim strConn As String
   strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & CurrentProject.Path & _
      "\mydb.mdb"
   Set conn = New ADODB.Connection
   conn.Open strConn
   Set rst = New ADODB.Recordset
   With rst
      .Open "Select * from Employees", conn, adOpenKeyset, _
          adLockOptimistic, adCmdText
   Debug.Print .AbsolutePosition
      .Move 3 " move forward 3 records
      Debug.Print .AbsolutePosition
      .MoveLast " move to the last record
      Debug.Print .AbsolutePosition
      Debug.Print .RecordCount
      .Close
   End With
   Set rst = Nothing
   conn.Close
   Set conn = Nothing
End Sub



Find record by using Recordset.FindFirst

 
Sub findrecorder()
    Dim dbNorthwind As DAO.Database
    Dim dbPath As String
    DbPath = CurrentProject.Path & "mydb.mdb"
    Set dbNorthwind = OpenDatabase(dbPath)
 
    Dim rsEmployees As DAO.Recordset
    Dim rsCustomers As DAO.Recordset
    Set rsEmployees = dbNorthwind.OpenRecordset("Employees", dbOpenTable)
    Set rsCustomers = dbNorthwind.OpenRecordset("Customers", dbOpenTable)
    rsCustomers.MoveLast
    numCustomers = rsCustomers.RecordCount
    With rsEmployees
        .FindFirst "City = "Seattle""
        If .NoMatch Then
            MsgBox ("No Records Found!")
            .MoveFirst
        Else
            MsgBox ("Found "& .Fields(2).Value & " "& .Fields(1).Value & _
                 "in Seattle")
        End If
    End With
End Sub



NoMatch property in Recordset

 
Sub SeekByPrice(curPrice As Currency)
  Dim db As Database
  Dim rec As Recordset
  Dim strSQL As String
  strSQL = "tblSales"
  Set db = CurrentDb()
  Set rec = db.OpenRecordset(strSQL)
  rec.Index = "AmountPaid"
  rec.Seek "=", curPrice
 
  If rec.NoMatch = True Then
    Debug.Print "No orders cost " & FormatCurrency(curPrice)
  Else
    Debug.Print "Order No. " & rec("SalesID") & " placed on " & _
         FormatDateTime(rec("DateOrdered"), vbLongDate) & _
         " cost " & FormatCurrency(rec("AmountPaid"))
  End If
  rec.Close
End Sub



Select specific column in select statement

 
Sub MyFirstConnection()
    Dim myConnection As ADODB.Connection
    Dim myRecordset As ADODB.Recordset
    Dim strSQL As String
 
    strSQL = "SELECT txtCustFirstName, txtCustLastName FROM tblCustomer"
    Set myConnection = CurrentProject.Connection
 
    Set myRecordset = New ADODB.Recordset
    myRecordset.Open strSQL, myConnection
 
    Do Until myRecordset.EOF
       Debug.Print myRecordset.Fields("txtCustFirstName") & " " & _
                   myRecordset.Fields("txtCustLastName")
       myRecordset.MoveNext
    Loop
    myRecordset.Close
    myConnection.Close
    Set myConnection = Nothing
    Set myRecordset = Nothing
End Sub



Simple Select statement

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



SQL with where clause

 
Sub MyFirstConnection()
    Dim myConnection As ADODB.Connection
    Dim myRecordset As ADODB.Recordset
    Dim strSQL As String
    Dim strSearch As String
 
    strSearch = "Joe"
 
    strSQL = "SELECT txtCustFirstName, txtCustLastName FROM tblCustomer" & _
              " WHERE txtCustLastName = " & " "" & strSearch & """
 
    Set myConnection = CurrentProject.Connection
 
    Set myRecordset = New ADODB.Recordset
    myRecordset.Open strSQL, myConnection
 
    Do Until myRecordset.EOF
       Debug.Print myRecordset.Fields("txtCustFirstName"), _
                   myRecordset.Fields("txtCustLastName")
       myRecordset.MoveNext
    Loop
    myRecordset.Close
    myConnection.Close
    Set myConnection = Nothing
    Set myRecordset = Nothing
End Sub