VBA - ADODB Update Multiple records (Any ways to speed this up?)

JumboCactuar

Well-known Member
Joined
Nov 16, 2016
Messages
785
Office Version
  1. 365
Platform
  1. Windows
Hi,
the code i have below works fine -
Updating multiple records from spreadsheet data where the ID (Column A) matches the record

But it can be slow with a lot of records, which is understandable opening and closing the recordset each time

Is there a better way to achieve this?

VBA Code:
Sub UpdateRecords()
   Dim cnn As ADODB.Connection
   Dim MyConn
   Dim rs As ADODB.Recordset
   Dim i As Long, j As Long
   Dim Rw As Long
   Dim sSQL As String

   Rw = Range("A10000").End(xlUp).Row

   Set cnn = New ADODB.Connection

   cnn.Open (ConnectionString)

   Set rst = New ADODB.Recordset
   rst.CursorLocation = adUseServer
           
   'Update one field in each record of the table. First record is in Row 2.
   For i = 9 To Rw
     sSQL = "SELECT * FROM MYTABLE WHERE MY_ID =" & Cells(i, 1).Value

    
        rst.Open Source:=sSQL, _
              ActiveConnection:=cnn, _
              CursorType:=adOpenKeyset, _
              LockType:=adLockOptimistic
           

    rst("DB_STATUS") = "Record Changed"
    rst("DB_CDATE") = CDbl(Format(Date, "YYYYMMDD"))
    rst("DB_CTIME") = CDbl(Format(Now, "HHMMSS"))
   
    rst.Update
    rst.Close
  
   Next i


   ' Close the connection
   cnn.Close
   Set rst = Nothing
   Set cnn = Nothing
 


End Sub

Thanks
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Here's one way of doing it and likely not the fastest. You'll need to consult CreateParameter Method (ADO) - ActiveX Data Objects (ADO) to determine which parameters to use for your MY_ID variable.

Alternatively you can just generate the SQL string in a loop each time. Ensure that you understand what the code does before running it or run for just a single row. I don't want to ruin your database.

VBA Code:
Sub UpdateRecords()
   Dim cnn As ADODB.Connection
   Dim MyConn
   'Dim rs As ADODB.Recordset
   Dim i As Long, j As Long
   Dim Rw As Long
   Dim sSQL As String
   Dim cmd As ADODB.Command
  
   Rw = Range("A10000").End(xlUp).Row

   Set cnn = New ADODB.Connection

   cnn.Open (ConnectionString)

    'sSQL = "SELECT * FROM MYTABLE WHERE MY_ID = ?" ' & Cells(i, 1).Value
    
    sSQL = "UPDATE MYTABLE" & _
           " SET DB_STATUS ='Record Changed',DB_CDATE=?,DB_CTIME=?" & _
           " WHERE MY_ID =?;"
    
    With cmd
        .ActiveConnection = cnn
        .CommandType = adCmdText
        .CommandText = sSQL
        .Prepared = True

        With .Parameters
            .Append cmd.CreateParameter("DB_CDATE", adDouble, adParamInput, 8)
            .Append cmd.CreateParameter("DB_CTIME", adDouble, adParamInput, 6)

            .Append cmd.CreateParameter("MY_ID",  , ,)

        End With
    End With

'   Set rst = New ADODB.Recordset
'   rst.CursorLocation = adUseServer
          
   'Update one field in each record of the table. First record is in Row 2.
   For i = 9 To Rw
        With cmd
            With .Parameters
                .Item("DB_CDATE").value = CDbl(Format(Date, "YYYYMMDD"))
                .Item("DB_CTIME").value = CDbl(Format(Now, "HHMMSS"))
                .Item("MY_ID").value = Cells(i, 1).value
            End With

            .Execute
            
        End With

'        rst.Open Source:=sSQL, _
'              ActiveConnection:=cnn, _
'              CursorType:=adOpenKeyset, _
'              LockType:=adLockOptimistic
          

'    rst("DB_STATUS") = "Record Changed"
'    rst("DB_CDATE") = CDbl(Format(Date, "YYYYMMDD"))
'    rst("DB_CTIME") = CDbl(Format(Now, "HHMMSS"))
  
    'rst.Update
    'rst.Close
 
   Next i


   ' Close the connection
   cnn.Close
   'Set rst = Nothing
   Set cnn = Nothing
 
End Sub
 
Upvote 0

Forum statistics

Threads
1,214,907
Messages
6,122,185
Members
449,071
Latest member
cdnMech

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top