访问 2013 VBA - 后续 SELECT 查询找不到 INSERT INTO 中的新记录



我正在通过VBA更新Access 2013表。我的任务要求在循环期间将某些记录添加到表中,然后从(更新的(表中读取记录。我发现我的代码按预期工作,前提是我在调试模式下逐行运行代码。但是,如果我使用 F5 运行代码,我的结果将是不可预测的。有时代码按预期工作,有时循环提前完成。选择查询似乎找不到新添加的记录,即使它们已添加到表中也是如此。参考下面的代码,执行底部的 INSERT INTO 语句,但随后打开 adrsb 记录集有时找不到更新的记录,导致循环提前终止。尽管我在调试方面尽了最大努力,但我已经为此难倒了好几天。任何帮助将不胜感激。:)

Do
i = i + 1
'Debug.Assert i <> 4
If adrsb.State = 1 Then
    adrsb.Close
    Set adrsb = Nothing
    Set adrsb = New ADODB.Recordset
    adrsb.ActiveConnection = CurrentProject.Connection
    adrsb.CursorType = adOpenStatic
End If
'adrsb.CursorType = adOpenDynamic
adrsb.Open "SELECT tblInScopeRestructures.Code1, tblInScopeRestructures.Gen " & _
"FROM tblInScopeRestructures " & _
"GROUP BY tblInScopeRestructures.Code1, tblInScopeRestructures.Gen " & _
"HAVING (((tblInScopeRestructures.Gen)=" & i & "))" & _
"ORDER BY tblInScopeRestructures.Code1;"
adrsb.Requery
Dim adrsc As ADODB.Recordset
Set adrsc = New ADODB.Recordset
adrsc.ActiveConnection = CurrentProject.Connection
adrsc.CursorType = adOpenStatic
If Not adrsb.EOF Then
    adrsb.MoveLast
    adrsb.MoveFirst
End If
If adrsb.RecordCount <> 0 Then
    adrsb.MoveFirst
    'strPrevCode1 = adrsb.Fields("Code1")
    Do While Not adrsb.EOF
    strPrevCode1 = adrsb.Fields("Code1")
        If adrsc.State = 1 Then
            adrsc.Close
        End If
        adrsc.CursorType = adOpenStatic
        adrsc.Open "SELECT tblRestructure.Code1, tblRestructure.Code2, tblRestructure.RecDate " & _
        "FROM tblRestructure " & _
        "WHERE (((tblRestructure.Code2)='" & strPrevCode1 & "'));"
        If adrsc.RecordCount <> 0 Then
        adrsc.MoveFirst
        Do While Not adrsc.EOF
       adConn.Execute ("INSERT INTO tblInScopeRestructures(Code1,Code2,RecDate,Gen) VALUES ('" & adrsc.Fields("Code1") & "','" & adrsc.Fields("Code2") & _
       "',#" & Format(adrsc.Fields("RecDate"), "mm/dd/yyyy") & "#," & i + 1 & ")")
       Debug.Print adrsc.Fields("Code1") & adrsc.Fields("Code2")
       Debug.Print i + 1
       For j = 1 To 100000
       Next j
       adrsc.MoveNext
        Loop
       End If
      adrsb.MoveNext
      If adrsc.State = 1 Then
           adrsc.Close
      End If
    Loop
End If
   Debug.Assert adrsb.RecordCount <> 0
Loop While adrsb.RecordCount <> 0
我认为

问题可能在这里

   adrsb.CursorType = adOpenStatic

将其更改为

   adrsb.CursorType = adOpenDynamic

而不是这段代码:

   For j = 1 To 100000
   Next j

您可以尝试一些稍微不那么捶打的东西,例如:

   DoEvents

也许在 DoEvents 命令之后,您可以尝试在 ADODB 记录集上添加重新查询命令。

除非您可能会丢失所需的游标位置,因此在执行刷新之前,您可以在变量中记录主键的 ID,然后在记录集中查找该游标位置

    intID = adrsb.Fields("MyKey")
    adrsb.Requery
    rs.Find "MyKey = " & intID

好的,我有各种各样的解决方案。我插入了以下代码以在第二个 EXECUTE INTO 操作后立即导致暂停:

       TWait = Time
       TWait = DateAdd("s", 5, TWait)
       Do Until TNow >= TWait
          TNow = Time
       Loop

这会非常显着地减慢代码速度,但它有效。我尝试了较短的暂停,但往往会在循环提前退出时遇到同样的问题。虽然眼前的问题已经解决,但我有点震惊,这是必要的,我担心这样的问题何时会再次抬头。

最新更新