我正在尝试通过按钮运行这段代码，这是我第一次使用VBA，我不确定为什么会出现此错误：
运行时错误“ 3021”：无当前记录。
在代码的这一行：
ConsumerID_1 = rs!CONSUMER_ID
该记录集有26k条记录，这是我第一次单击它起作用的按钮，但是在重新单击该错误时会出现。
这是我的代码：
Private Sub Command23_Click()
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("tbl_30days_NoDefaults", dbOpenDynaset)
'1. Start of recordset
'2. Store 1st Consumer ID (v1)
'3. Move to next record
'4. Store 2nd Consumer ID (v2)
'5. Compare both Consumer IDs for a match
'6. If matched Then move to previous record and store repair date (v3), go
to 8.
' 7. Else Move to next record and loop back to 2.
'8. Move to next record and store call date (v4)
'9. Compare repair date and call date and find the difference between them
to check If they are within 30 days of each other
'10. If <30 days, move to previous record and check Repeat field boolean
True/Yes
'11. Move to next record and loop back to 2.
Dim ConsumerID_1 As Long
Dim ConsumerID_2 As Long
Dim RepairDate As Date
Dim CallDate As Date
Dim DiffDate As Long
rs.MoveFirst
Do Until rs.EOF
FirstLoop:
ConsumerID_1 = rs!CONSUMER_ID
rs.MoveNext
ConsumerID_2 = rs!CONSUMER_ID
If ConsumerID_1 = ConsumerID_2 Then
rs.MovePrevious
RepairDate = rs!RepairDate
rs.MoveNext
CallDate = rs!CsrCallDate
DiffDate = DateDiff("d", RepairDate, CallDate)
If DiffDate <= 30 Then
rs.MovePrevious
rs.Edit
rs!RepeatBoolean = True
rs.Update
rs.MoveNext
GoTo FirstLoop
Else
rs.MovePrevious
rs.Edit
rs!RepeatBoolean = False
rs.Update
rs.MoveNext
GoTo FirstLoop
End If
Else
rs.MoveNext
GoTo FirstLoop
End If
Loop
rs.Close
End Sub
是因为我没有清除变量，还是因为我使用了错误的循环类型？
编辑＃1
Snapshot of table in current form和Snapshot of table in current form
某些记录已被成功捕获，而另一些则被完全错过了。
我将进一步澄清，最初给我的是数据转储，所有记录没有特定顺序。我使用了选择查询和表查询，以将这些数据放入更易于理解的记录集中。相关字段包括CSR（唯一，没有重复），CONSUMER_ID（每个使用者唯一，但是由于每个使用者可以有多个调用，所以有重复），CsrModel，CsrSerialNumber，CsrCallDate，RepairDate和RepeatBoolean。
有人告诉我将记录按三个字段分组：CONSUMER_ID，CsrModel和CsrSerialNumber。因此，例如，当您上拉表时，可能会出现3次CONSUMER_ID以及匹配的相同CsrModel号和CsrSerialNumber。每个使用者的CSR字段按升序排列，因此CsrCallDate和RepairDate的顺序也从旧到新。我的目标是遍历每条记录，并首先检查CONSUMER_ID是否匹配，然后执行此代码以检查是否满足30天标准。
目前，我的问题是，在多次测试代码之后，它无法捕获所有必需的记录，由于我不完全理解而错过了一些记录。如果我使用两个记录集，是否可以解决问题？
以下是构成上表的查询中的SQL：
SELECT tbl_30days_CSR.CONSUMER_ID, tbl_30days_CSR.CSR,
tbl_30days_CSR.CsrCallDate, tbl_30days_CSR.RepairDate,
tbl_30days_CSR.CsrModel, tbl_30days_CSR.CsrSerialNumber
FROM tbl_30days_CSR
GROUP BY tbl_30days_CSR.CONSUMER_ID, tbl_30days_CSR.CSR,
tbl_30days_CSR.CsrCallDate, tbl_30days_CSR.RepairDate,
tbl_30days_CSR.CsrModel, tbl_30days_CSR.CsrSerialNumber
HAVING (((tbl_30days_CSR.CONSUMER_ID) In (SELECT [CONSUMER_ID] FROM
[tbl_30days_CSR] As Tmp GROUP BY [CONSUMER_ID] HAVING Count(*)>1 )) AND
((tbl_30days_CSR.CsrModel) In (SELECT [CsrModel] FROM [tbl_30days_CSR] As
Tmp GROUP BY [CsrModel] HAVING Count(*)>1 )) AND
((tbl_30days_CSR.CsrSerialNumber) In (SELECT [CsrSerialNumber] FROM
[tbl_30days_CSR] As Tmp GROUP BY [CsrSerialNumber] HAVING Count(*)>1 ) And
(tbl_30days_CSR.CsrSerialNumber)<>565432105 And
(tbl_30days_CSR.CsrSerialNumber)<>1));
编辑＃2
使用Jericho解决方案的当前代码，但是仍然无法捕获所有内容：
Private Sub Command26_Click()
'Dim db As DAO.Database
Dim rstConsumers As DAO.Recordset
Dim rstCalls As DAO.Recordset
Dim mssql As String
Dim RepairDate As Date
'Set db = CurrentDb()
' ==============================
' Get a unique list of Consumer_ID's into a RecordSet
' ==============================
mssql = "SELECT tbl_30days_CSR_NoDefaultsOr1s_v2.CONSUMER_ID FROM
tbl_30days_CSR_NoDefaultsOr1s_v2 GROUP BY CONSUMER_ID;"
Set rstConsumers = CurrentDb.OpenRecordset(mssql, dbOpenSnapshot)
Do While Not rstConsumers.EOF
' ==============================
' For each unique Consumer_ID, get the list of Calls in date order
' ==============================
mssql = "SELECT * FROM tbl_30days_CSR_NoDefaultsOr1s_v2 WHERE
tbl_30days_CSR_NoDefaultsOr1s_v2.CONSUMER_ID = " & rstConsumers("CONSUMER_ID")
mssql = mssql & " ORDER BY tbl_30days_CSR_NoDefaultsOr1s_v2.CSR;"
Set rstCalls = CurrentDb.OpenRecordset(mssql, dbOpenDynaset)
Do While Not rstCalls.EOF
RepairDate = rstCalls("RepairDate")
rstCalls.MoveNext
If Not rstCalls.EOF Then
If DateDiff("d", RepairDate, rstCalls("CsrCallDate")) <= 30 And
DateDiff("d", RepairDate, rstCalls("CsrCallDate")) >= -30 And
DateDiff("d", RepairDate, rstCalls("CsrCallDate")) = 0 Then
rstCalls.MovePrevious
rstCalls.Edit
rstCalls("RepeatBoolean") = True
rstCalls.Update
'Else NOT REQUIRED SINCE DEFUALT IS UNCHECKED (FALSE)
'rstCalls.MovePrevious
'rstCalls.Edit
'rstCalls("RepeatBoolean") = False
'rstCalls.Update
End If
rstCalls.MoveNext
End If
Loop
' ==============================
' After we have processed all of the Calls for this Consumer_ID
' Close the RecordSet for these Calls and loop to the next Consumer_ID
' ==============================
rstCalls.Close
rstConsumers.MoveNext
Loop
MsgBox "Finished looping through records."
rstConsumers.Close
'Set db = Nothing
'db.Close
End Sub
编辑＃3
最终编辑＃4
Private Sub Command26_Click()
'Dim db As DAO.Database
Dim rstConsumers As DAO.Recordset
Dim rstCalls As DAO.Recordset
Dim mssql As String
Dim RepairDate As Date
'Set db = CurrentDb()
' ==============================
' Get a unique list of Consumer_ID's into a RecordSet
' ==============================
mssql = "SELECT tbl_30days_CSR_NoDefaultsOr1s_v2.CONSUMER_ID FROM
tbl_30days_CSR_NoDefaultsOr1s_v2 GROUP BY CONSUMER_ID;"
Set rstConsumers = CurrentDb.OpenRecordset(mssql, dbOpenSnapshot)
Do While Not rstConsumers.EOF
' ==============================
' For each unique Consumer_ID, get the list of Calls in date order
' ==============================
mssql = "SELECT * FROM tbl_30days_CSR_NoDefaultsOr1s_v2 WHERE
tbl_30days_CSR_NoDefaultsOr1s_v2.CONSUMER_ID = " &
rstConsumers("CONSUMER_ID")
mssql = mssql & " ORDER BY tbl_30days_CSR_NoDefaultsOr1s_v2.CSR;"
Set rstCalls = CurrentDb.OpenRecordset(mssql, dbOpenDynaset)
Do While Not rstCalls.EOF
RepairDate = rstCalls("RepairDate")
rstCalls.MoveNext
If Not rstCalls.EOF Then
If DateDiff("d", RepairDate, rstCalls("CsrCallDate")) <= 30 And
DateDiff("d", RepairDate, rstCalls("CsrCallDate")) >= -30 Then
rstCalls.MovePrevious
rstCalls.Edit
rstCalls("RepeatBoolean") = True
rstCalls.Update
rstCalls.MoveNext 'MOVED HERE***
'Else NOT REQUIRED SINCE DEFUALT IS UNCHECKED (FALSE)
'rstCalls.MovePrevious
'rstCalls.Edit
'rstCalls("RepeatBoolean") = False
'rstCalls.Update
End If
rstCalls.MoveNext 'MOVED INSIDE THE IF STATEMENT***
End If
Loop
' ==============================
' After we have processed all of the Calls for this Consumer_ID
' Close the RecordSet for these Calls and loop to the next Consumer_ID
' ==============================
rstCalls.Close
rstConsumers.MoveNext
Loop
MsgBox "Finished looping through records."
rstConsumers.Close
'Set db = Nothing
'db.Close
End Sub
答案 0 :(得分：2)
虽然有不同的方法可以达到预期的结果，但是当前代码的问题在于，通过使用GoTo FirstLoop命令，您正在绕过EOF检查Do Until rs.EOF行应该执行。因此，您的代码实际上正在遍历所有记录，并且您的rs.MoveNext行之一导致Recordset到达EOF，而您的GoTo FirstLoop直接将您带到尝试检索值不存在，因此会产生错误。
您的Do循环是一个循环，因此无需人为地强制使用GoTo语句进行循环。
我已经修改了您的循环，以允许EOF检查完成其工作并在记录用完时退出循环。
基于您的RecordSet中记录的奇数或偶数，我希望您的原始代码能够以不同的方式运行。但是我也认为您的原始代码在发生错误之前将是一个无限循环，因为我看不到您的原始代码退出循环的方法。所有三个执行路径（您的各种If Then Else语句）都包含一个GoTo FirstLoop，因此看来您的代码只能在最终到达EOF时以错误结尾。
' ==============================
' The original rs.MoveFirst line is not needed before the loop
' and would actually generate an error if there
' happened to be zero (0) records returned in the RecordSet
' ==============================
Do While Not rs.EOF
ConsumerID_1 = rs!CONSUMER_ID
rs.MoveNext
' ==============================
' Always check for EOF after a MoveNext
' before retrieving a value
' ==============================
If Not rs.EOF Then
ConsumerID_2 = rs!CONSUMER_ID
If ConsumerID_1 = ConsumerID_2 Then
rs.MovePrevious
RepairDate = rs!RepairDate
rs.MoveNext
' ==============================
' Since we have already performed a MoveNext
' and MovePrevious, we know these two records
' exist and it is safe to exclude the EOF check
' ==============================
CallDate = rs!CsrCallDate
DiffDate = DateDiff("d", RepairDate, CallDate)
If DiffDate <= 30 Then
rs.MovePrevious
rs.Edit
rs!RepeatBoolean = True
rs.Update
Else
rs.MovePrevious
rs.Edit
rs!RepeatBoolean = False
rs.Update
End If
End If
rs.MoveNext
End If
Loop
rs.Close
我还删除了一些多余的rs.MoveNext命令，并将它们合并为一行，以前存在的所有三种情况仍将执行。
此代码将执行与原始代码相同的操作，并且当表中的记录数为奇数时，也不会出错。
更新＃1
基于OP的注释中的其他问题，以下代码应提供预期的结果。
Dim db As DAO.Database
Dim rstConsumers As DAO.Recordset
Dim rstCalls As DAO.Recordset
Dim mssql As String
Dim RepairDate As Date
Set db = CurrentDb()
' ==============================
' Get a unique list of Consumer_ID's into a RecordSet
' ==============================
mssql = "SELECT CONSUMER_ID FROM tbl_30days_NoDefaults GROUP BY CONSUMER_ID;"
Set rstConsumers = db.OpenRecordset(mssql, dbOpenSnapshot)
Do While Not rstConsumers.EOF
' ==============================
' For each unique Consumer_ID, get the list of Calls in date order
' ==============================
mssql = "SELECT * FROM tbl_30days_NoDefaults WHERE CONSUMER_ID = " & rstConsumers("CONSUMER_ID")
mssql = mssql & " ORDER BY CsrCallDate;"
Set rstCalls = db.OpenRecordset(mssql, dbOpenDynaset)
Do While Not rstCalls.EOF
RepairDate = rstCalls("RepairDate")
rstCalls.MoveNext
If Not rstCalls.EOF Then
If DateDiff("d", RepairDate, rstCalls("CsrCallDate")) <= 30 Then
rstCalls.MovePrevious
rstCalls.Edit
rstCalls("RepeatBoolean") = True
rstCalls.Update
Else
rstCalls.MovePrevious
rstCalls.Edit
rstCalls("RepeatBoolean") = False
rstCalls.Update
End If
rstCalls.MoveNext
End If
Loop
' ==============================
' After we have processed all of the Calls for this Consumer_ID
' Close the RecordSet for these Calls and loop to the next Consumer_ID
' ==============================
rstCalls.Close
rstConsumers.MoveNext
Loop
rstConsumers.Close
Set db = Nothing
db.Close