Access VBA循环执行1次后出现“No Current Record”错误求助

问题描述 #

我有一个存储主管与员工信息的Access数据库，需要为每位员工添加配置表指定数量的任务记录。先循环获取主管列表，再循环获取员工列表（分别存入不同记录集），这部分运行正常。但添加For循环后，程序完成第1位主管对应的每位员工的1条任务记录后，进入下一轮循环尝试为员工添加第2条任务记录时，触发运行时错误'3021：No Current Record'。

相关代码片段：

gSQL = "SELECT AssocID, Position, StatusCodeID FROM tblHistory WHERE (((tblHistory.Position) In (SELECT ConfigLongDesc FROM ref_Config WHERE ConfigShortDesc In ('Supervisors'))) AND tblHistory.StatusCodeID = '3')"

Set gRST = CurrentDb.OpenRecordset(gSQL)
...
    If gRST.RecordCount > 0 Then
        gRST.MoveFirst

        Do Until gRST.EOF
            aSQL = "SELECT AssocID, Position, StatusCodeID FROM tblHistory WHERE (((tblHistory.Position) In (SELECT ConfigLongDesc FROM ref_Config WHERE ConfigShortDesc In ('Employees'))) AND tblHistory.StatusCodeID = '3')"

            Set aRST = CurrentDb.OpenRecordset(aSQL)

            If aRST.RecordCount > 0 Then
                aRST.MoveFirst

                myCadence = DLookup("[ConfigLongDesc]", "ref_Config", "[ConfigShortDesc] = 'Frequency'")

                Do Until aRST.EOF
                    For i = 0 To myCadence

                        Debug.Print aRST!AssocID
                        aRST.MoveNext
                    Next i
                Loop
            End If
            gRST.MoveNext
        Loop
    End If
Else
    Exit Function
End If

错误原因 #

问题核心在于内层For循环中的aRST.MoveNext：

• 原代码中，For循环从0到myCadence会执行myCadence+1次，每次循环都移动员工记录集指针，直接将指针移到了记录集末尾（EOF状态）。
• 外层的Do Until aRST.EOF循环继续执行时，aRST已无当前记录，此时访问aRST!AssocID就会触发3021错误。

修复方案 #

调整逻辑：先保存当前员工的ID，在For循环中重复使用该ID生成指定数量的记录，之后再移动记录集指针到下一位员工。同时优化资源管理：

gSQL = "SELECT AssocID, Position, StatusCodeID FROM tblHistory WHERE (((tblHistory.Position) In (SELECT ConfigLongDesc FROM ref_Config WHERE ConfigShortDesc In ('Supervisors'))) AND tblHistory.StatusCodeID = '3')"

Set gRST = CurrentDb.OpenRecordset(gSQL)
...
    If gRST.RecordCount > 0 Then
        gRST.MoveFirst

        Do Until gRST.EOF
            aSQL = "SELECT AssocID, Position, StatusCodeID FROM tblHistory WHERE (((tblHistory.Position) In (SELECT ConfigLongDesc FROM ref_Config WHERE ConfigShortDesc In ('Employees'))) AND tblHistory.StatusCodeID = '3')"

            Set aRST = CurrentDb.OpenRecordset(aSQL)

            If aRST.RecordCount > 0 Then
                aRST.MoveFirst

                ' 将配置值转换为数值，避免字符串类型导致循环次数错误
                myCadence = Val(DLookup("[ConfigLongDesc]", "ref_Config", "[ConfigShortDesc] = 'Frequency'"))

                Do Until aRST.EOF
                    ' 保存当前员工的ID，避免移动指针后无法访问
                    Dim currentAssocID As Variant
                    currentAssocID = aRST!AssocID

                    ' 循环生成指定数量的任务记录（以打印为例）
                    For i = 1 To myCadence
                        Debug.Print currentAssocID
                    Next i

                    ' 移动到下一位员工
                    aRST.MoveNext
                Loop
            End If
            
            ' 释放员工记录集资源
            aRST.Close
            Set aRST = Nothing
            gRST.MoveNext
        Loop
    End If
    
    ' 释放主管记录集资源
    gRST.Close
    Set gRST = Nothing
Else
    Exit Function
End If

额外优化点 #

• 将myCadence转换为数值类型：DLookup默认返回字符串，直接用于循环可能引发类型错误。
• 调整循环次数：从1到myCadence确保生成的记录数与配置的任务数量完全匹配，避免原代码多一次循环。
• 手动关闭记录集并释放对象：避免Access后台资源泄漏，提升程序稳定性。

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