VBA/Excel/Access/Word/Access/Recordset Add Update Delete

Материал из VB Эксперт
Версия от 12:46, 26 мая 2010; Admin (обсуждение | вклад) (1 версия)
(разн.) ← Предыдущая | Текущая версия (разн.) | Следующая → (разн.)
Перейти к: навигация, поиск

Adding a New Record to a Recordset

 
Sub cmdAddADO()
    Dim rst As ADODB.Recordset
        Set rst = New ADODB.Recordset
        With rst
            .ActiveConnection = CurrentProject.Connection
            .CursorType = adOpenKeyset
            .LockType = adLockOptimistic
            .Open "Select * from Employees Where EmployeeID = 0"
            .AddNew
                !FirstName = "newF"
                !LastName = "newL"
                !Region = "new"
            .Update
        End With
End Sub



Adding a New Record to a Table

 
" Use the References dialog box to set up a reference to the Microsoft ActiveX Data Objects Library
Sub Add_Record()
   Dim conn As ADODB.Connection
   Dim myRecordset As ADODB.Recordset
   Dim strConn As String
   strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\mydb.mdb"
   Set myRecordset = New ADODB.Recordset
   With myRecordset
      .Open "Select * from Employees", _
         strConn, adOpenKeyset, adLockOptimistic
      .AddNew
      !LastName = "Marco"
      !FirstName = "Paulo"
      !City = "Boston"
      .MoveFirst
      .Close
   End With
   Set myRecordset = Nothing
   Set conn = Nothing
End Sub



Add new a row to recordset

 
Sub exaRecordsetAddNew()
    Dim db As Database
    Dim rs As Recordset
    
    Set db = CurrentDb
    Set rs = db.OpenRecordset("Books")
    Debug.Print "Current title: " & rs!Title
    With rs
       .AddNew             " Add new record
       !ISBN = "0-000"     " Set fields
       !Title = "New Book"
       !PubID = 1
       !Price = 100
       .Update             " Save changes.
       .Bookmark = rs.LastModified   " Go to new record
       Debug.Print "Current title: " & rs!Title
    End With
    
    rs.Close
End Sub



Call delete method in Recordset

 
Public Sub RemoveCompany()
  Dim rst As ADODB.Recordset
  Dim strSQL As String
  Set rs = New ADODB.Recordset
  rs.Open "SELECT * FROM tblCompany WHERE CompanyID=14", CurrentProject.Connection, adOpenStatic, adLockOptimistic
  With rs
    If .RecordCount > 0 Then
      .Delete
    End If
  End With
  rs.Close
  Set rs = Nothing
End Sub



Call update method from Recordset

 
Public Sub ADOUpdate()
  Dim rs As ADODB.Recordset
  Dim strSQL As String
  
  Set rs = New ADODB.Recordset
  strSQL = "SELECT CompanyName, Address, City FROM tblCompany WHERE (CompanyName = "Liams Diner")"
  
  rs.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
  
  With rs
    !CompanyName = "Diner"
    .Update
  End With
  rs.Close
End Sub



Check the Recordset affected

 
Sub exaCreateAction2()
    Dim ws As Workspace
    Dim db As Database
    Dim qdf As QueryDef
    Dim strSQL As String
    Set ws = DBEngine(0)
    Set db = CurrentDb
    strSQL = "UPDATE BOOKS SET Price = Price*1.1 WHERE Price > 20"
    Set qdf = db.CreateQueryDef("PriceInc", strSQL)
    ws.BeginTrans
    qdf.Execute
    If qdf.RecordsAffected > 15 Then
        Debug.Print qdf.RecordsAffected
        ws.Rollback
    Else
        Debug.Print qdf.RecordsAffected
        ws.rumitTrans
    End If
    
End Sub



Delete row for a certain criteria

 
Sub exaRecordsetDelete()
    Dim db As Database
    Dim rs As Recordset
    Dim DeleteCt As Integer
    
    Set db = CurrentDb
    Set rs = db.OpenRecordset("Books Copy")
    
    DeleteCt = 0
    
    rs.MoveFirst
    Do While Not rs.EOF
       If rs!Price > 20 Then
             rs.Delete
             DeleteCt = DeleteCt + 1
       End If
       rs.MoveNext
    Loop
    
    rs.Close
    
    Debug.Print Format$(DeleteCt) & " records deleted."
End Sub



Deleting a Record

 
Sub Delete_Record()
   Dim conn As ADODB.Connection
   Dim myRecordset As ADODB.Recordset
   Dim strConn As String
   Dim strCriteria As String
   strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\mydb.mdb"
   Set conn = New ADODB.Connection
   Set myRecordset = New ADODB.Recordset
   With myRecordset
      .Open "Select * from Employees Where LastName ="Marco"", _
          strConn, adOpenKeyset, adLockOptimistic
      .Delete
      .Close
   End With
   Set myRecordset = Nothing
   Set conn = Nothing
End Sub



Modifying a Record

 
Sub Update_Record()
   Dim conn As ADODB.Connection
   Dim myRecordset As ADODB.Recordset
   Dim strConn As String
   strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\mydb.mdb"
   Set myRecordset = New ADODB.Recordset
   With myRecordset
      .Open "Select * from Employees Where LastName = "Marco"", _
         strConn, adOpenKeyset, adLockOptimistic
      .Fields("FirstName").Value = "A"
      .Fields("City").Value = "D"
      .Fields("Country").Value = "USA"
      .Update
      .Close
   End With
   Set myRecordset = Nothing
   Set conn = Nothing
End Sub



Use AddNew and specify the field information

 
Public Sub addCustomer()
  Dim conn As ADODB.Connection
  Dim rs As ADODB.Recordset
  Set conn = CurrentProject.Connection
  Set rs = New ADODB.Recordset
  rs.Open "tblCompany", conn, adOpenDynamic, adLockOptimistic, adCmdTable
  With rs
    .AddNew
    .Fields("CompanyName") = "Diner"
    .Fields("Address") = "Road"
    .Fields("City") = "New York"
    .Update
  End With
End Sub



Use AddNew method from Recordset and two arrays to add a new row

 
Public Sub addCustomerArray()
  Dim conn As ADODB.Connection
  Dim rs As ADODB.Recordset
  Set conn = CurrentProject.Connection
  Set rs = New ADODB.Recordset
  rs.Open "tblCompany", conn, adOpenDynamic, adLockOptimistic, adCmdTable
    
  varfields = Array("CompanyName", "Address", "City")
  varValues = Array("A", "Road", "B")
  rs.AddNew varfields, varValues
  rs.Update
End Sub