VBA执行SQL Server UPDATE查询挂起，记录数超16即异常

我有一个操作SQL Server数据库的VBA脚本，负责插入和更新表记录，但更新部分出现挂起异常：

• 脚本流程：先通过INSERT语句插入18条记录，随后循环这些记录，用UPDATE语句更新每条的2个字段
• 异常表现：UPDATE语句在SQL Server中直接执行可立即完成，但在VBA中执行无法结束；测试发现临界值为16条：插入16条及以下时更新正常，增至17条及以上时更新就会挂起
• 已尝试：修改Recordset对象后问题仍未解决

示例脚本如下：

Sub ExecuteMyScript()
  '声明局部变量
    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
    
  '打开主连接
    Set vCNSHARE = New ADODB.Connection
    vCNSHARE.ConnectionTimeout = 3600
    vCNSHARE.Open "my_sqlserver_connection_string"
    
  '设置命令和记录集对象，并关联到共享连接
   '设置插入操作对象：用于插入记录
    Set vCMINSERT = New ADODB.Command
    vCMINSERT.ActiveConnection = vCNSHARE
    vCMINSERT.CommandType = adCmdText
    Set vRSINSERT = New ADODB.Recordset
    
   '设置循环操作对象：用于遍历插入的记录
    Set vCMLOOP = New ADODB.Command
    vCMLOOP.ActiveConnection = vCNSHARE
    vCMLOOP.CommandType = adCmdText
    Set vRSLOOP = New ADODB.Recordset
    
   '设置更新操作对象：用于更新插入的记录
    Set vCMUPDATE = New ADODB.Command
    vCMUPDATE.ActiveConnection = vCNSHARE
    vCMUPDATE.CommandType = adCmdText
    Set vRSUPDATE = New ADODB.Recordset
    
  '执行流程
   '插入记录
   '完整INSERT语句未展示，实际是基于JSON插入18条记录
   'JSON中包含参考ID，用于UPDATE语句定位目标记录
    vCMINSERT.CommandText = "INSERT INTO [MYTABLE] (blah, MYTABLE_REFERNCEID) SELECT blah, MYTABLE_REFERNCEID"
    Set vRSINSERT = vCMINSERT.Execute()
    
   '遍历插入的记录
    vCMLOOP.CommandText = "SELECT * FROM [MYTABLE] WHERE MYTABLE_ID = {it_finds_the_record_added}"
    Set vRSLOOP = vCMLOOP.Execute()
    
    Do Until vRSLOOP.EOF
       '获取参考ID，用于UPDATE语句
        vREFERENCEID = vRSLOOP("MYTABLE_REFERNCEID").Value

       '更新记录：执行到此处时出现挂起
        vCMUPDATE.CommandText = MyUpdateScript(MyReference:=vREFERENCEID)
        Set vRSUPDATE = vCMUPDATE.Execute()
       
       '移动到下一条插入的记录     
        vRSLOOP.MoveNext
    Loop
    
  '清理资源
   '关闭连接并释放对象
    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 = vSCRIPT
End Function

编辑补充：
即使将更新操作对应的Recordset对象从vRSLOOP替换为vRSUPDATE，问题仍然存在。相关对象设置代码如下：

'用于更新插入记录的对象设置
Set vCMUPDATE = New ADODB.Command
vCMUPDATE.ActiveConnection = vCNSHARE
vCMUPDATE.CommandType = adCmdText
Set vRSUPDATE = New ADODB.Recordset

内容的提问来源于stack exchange，提问作者ptownbro