VBA/Excel/Access/Word/Access/Recordset Update

Modifying One Record at a Time

 
Sub IncreaseEstimateImproved()
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    Dim lngUpdated As Long
    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenDynamic
    rst.LockType = adLockOptimistic
    rst.Open ("Select * from Products " & _
        "WHERE UnitPrice < 30000")
    Do Until rst.EOF
        lngUpdated = lngUpdated + 1
        rst("UnitPrice") = rst("UnitPrice") * 1.1
        rst.Update
        rst.MoveNext
    Loop
    Debug.Print lngUpdated & " Records Updated"
    rst.Close
    Set rst = Nothing
End Sub

Performing Batch Updates

 
Sub BatchUpdates()
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    Dim strSQL As String
    Dim lngUpdated As Long
    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenKeyset
    rst.CursorLocation = adUseClient
    rst.LockType = adLockBatchOptimistic
    rst.Open ("Select * from Products ")
    strSQL = "UnitPrice < 30000"
    lngUpdated = 0
    rst.Find strSQL
    Do Until rst.EOF
        lngUpdated = lngUpdated + 1
        rst("UnitPrice") = rst("UnitPrice") * 1.1
        rst.Find strSQL, 1, adSearchForward
    Loop
    rst.UpdateBatch
    Debug.Print lngUpdated & " Records Updated"
    rst.Close
    Set rst = Nothing
End Sub

Update Recordset

 
Sub IncreaseEstimate()
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    Dim strSQL As String
    Dim lngUpdated As Long
    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenDynamic
    rst.LockType = adLockOptimistic
    rst.Open ("Select * from Products")
    strSQL = "UnitPrice < 30000"
    lngUpdated = 0
    rst.Find strSQL
    Do Until rst.EOF
        lngUpdated = lngUpdated + 1
        rst("UnitPrice") = rst("UnitPrice") * 1.1
        rst.Update
        rst.Find strSQL, 1, adSearchForward
    Loop
    "Print how many rows are updated
    Debug.Print lngUpdated & " Records Updated"
    rst.Close
    Set rst = Nothing
End Sub