Update Query from VBA to SQL Server Hangs - sql

Question

I have a VBA script that is inserting and updating records in a SQL Server database table. However, the update part of the script is hanging.
The script first inserts 18 records into a table using an INSERT query. Then, it loops through each of those 18 records to update 2 fields in each record using an UPDATE query. The update query is fairly simple and when I run it directly in SQL Server it runs immediately. However, that same UPDATE query will not finish when executed in VBA.
The sweet spot seems to be 16 records. If I only include 16 of the 18 records in the original insert, the update query works fine. As soon as I increase it to 17 records, it doesn't.
Sample script below.
Sub ExecuteMyScript()
'Declare local variables.
Dim vCNSHARE As ADODB.Connection
Dim vCMINSERT As ADODB.Command, vCMLOOP As ADODB.Command, vCMUPDATE As ADODB.Command
Dim vRSINSERT As ADODB.Recordset, vRSLOOP As ADODB.Recordset, vRSUPDATE As ADODB.Recordset
Dim vREFERENCEID As String
'Open main connection.
Set vCNSHARE = New ADODB.Connection
vCNSHARE.ConnectionTimeout = 3600
vCNSHARE.Open "my_sqlserver_connection_string"
'Set the command and record objects and apply the to the shared connection.
'Set Insert objects. Used to insert the records.
Set vCMINSERT = New ADODB.Command
vCMINSERT.ActiveConnection = vCNSHARE
vCMINSERT.CommandType = adCmdText
Set vRSINSERT = New ADODB.Recordset
'Set Loop objects. Used to loop through the records inserted.
Set vCMLOOP = New ADODB.Command
vCMLOOP.ActiveConnection = vCNSHARE
vCMLOOP.CommandType = adCmdText
Set vRSLOOP = New ADODB.Recordset
'Set Update objects. Used to update the records inserted.
Set vCMUPDATE = New ADODB.Command
vCMUPDATE.ActiveConnection = vCNSHARE
vCMUPDATE.CommandType = adCmdText
Set vRSUPDATE = New ADODB.Recordset
'Run process.
'Insert the records.
'The full INSERT query is not shown, but it inserts 18 records based on a JSON.
'The JSON has a reference ID that is used in the UPDATE query to find the relevant record inserted.
vCMINSERT.CommandText = "INSERT INTO [MYTABLE] (blah, MYTABLE_REFERNCEID) SELECT blah, MYTABLE_REFERNCEID"
Set vRSINSERT = vCMINSERT.Execute()
'Loop through the records inserted.
vCMLOOP.CommandText = "SELECT * FROM [MYTABLE] WHERE MYTABLE_ID = {it_finds_the_record_added}"
Set vRSLOOP = vCMLOOP.Execute()
Do Until vRSLOOP.EOF
'Retrieve the reference to use it in the UPDATE query.
vREFERENCEID = vRSLOOP("MYTABLE_REFERNCEID").Value
'Update the recrods. This hangs when the EXECUTE is run.
vCMUPDATE.CommandText = MyUpdateScript(MyReference:=vREFERENCEID)
Set vRSUPDATE = vCMUPDATE.Execute()
'Move to the next record that was inserted.
vRSLOOP.MoveNext
Loop
'All done.
'Close connnection and clear objects.
vCNSHARE.Close
Set vCMINSERT = Nothing
Set vCMLOOP = Nothing
Set vCMUPDATE = Nothing
Set vRSINSERT = Nothing
Set vRSLOOP = Nothing
Set vRSUPDATE = Nothing
End Sub
Function MyUpdateScript(MyReference As String) As String
Dim vSCRIPT As String
vSCRIPT = ""
vSCRIPT = vSCRIPT & "DECLARE #JSON AS nvarchar(max);
vSCRIPT = vSCRIPT & "SET #JSON = N'[
vSCRIPT = vSCRIPT & " {
vSCRIPT = vSCRIPT & " ""label"": ""simplejson"", "
vSCRIPT = vSCRIPT & " ""fields"": [ "
vSCRIPT = vSCRIPT & " {
vSCRIPT = vSCRIPT & " ""field1"": ""Some Value 1"", "
vSCRIPT = vSCRIPT & " ""field2"": ""Some Value 2"" "
vSCRIPT = vSCRIPT & " } "
vSCRIPT = vSCRIPT & " ] "
vSCRIPT = vSCRIPT & " } "
vSCRIPT = vSCRIPT & "]'; "
vSCRIPT = vSCRIPT & "UPDATE "
vSCRIPT = vSCRIPT & " [MYTABLE] "
vSCRIPT = vSCRIPT & "SET "
vSCRIPT = vSCRIPT & " [MYTABLE_FIELD1]=T0.[MYTABLE_FIELD1], "
vSCRIPT = vSCRIPT & " [MYTABLE_FIELD2]=T0.[MYTABLE_FIELD2] "
vSCRIPT = vSCRIPT & "FROM ( "
vSCRIPT = vSCRIPT & " SELECT "
vSCRIPT = vSCRIPT & " [MYTABLE_FIELD1], "
vSCRIPT = vSCRIPT & " [MYTABLE_FIELD2] "
vSCRIPT = vSCRIPT & " FROM "
vSCRIPT = vSCRIPT & " OPENJSON (#JSON) WITH ( "
vSCRIPT = vSCRIPT & " MYTABLE_DETAILFIELDS nvarchar(max) '$.fields' AS JSON "
vSCRIPT = vSCRIPT & " ) AS T1 "
vSCRIPT = vSCRIPT & " CROSS APPLY "
vSCRIPT = vSCRIPT & " OPENJSON (T1.MYTABLE_DETAILFIELDS) WITH ( "
vSCRIPT = vSCRIPT & " MYTABLE_FIELD1 nvarchar(300) '$.field1', "
vSCRIPT = vSCRIPT & " MYTABLE_FIELD2 nvarchar(300) '$.field2' "
vSCRIPT = vSCRIPT & " ) AS T2 "
vSCRIPT = vSCRIPT & ") AS T0"
vSCRIPT = vSCRIPT & "WHERE "
vSCRIPT = vSCRIPT & " [MYTABLE_REFERNCEID] = '" & MyReference & "'"
MyUpdateScript = vSTRING
End Function
EDIT:
As suggested, changed "vRSLOOP" to "vRSUPDATE" and the code still hangs
'Set Update objects. Used to update the records inserted.
Set vCMUPDATE = New ADODB.Command
vCMUPDATE.ActiveConnection = vCNSHARE
vCMUPDATE.CommandType = adCmdText
Set vRSLOOP = New ADODB.Recordset

Answer 1

Set the intended recordset:
'Set Update objects. Used to update the records inserted.
Set vCMUPDATE = New ADODB.Command
vCMUPDATE.ActiveConnection = vCNSHARE
vCMUPDATE.CommandType = adCmdText
Set vRSUPDATE = New ADODB.Recordset