无法遍历整个Recordset

问题描述 投票：0回答：1

我试图通过一个按钮运行这段代码，这是我第一次使用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

一些记录已被成功捕获，而其他记录已被完全遗漏。

我将进一步澄清，我最初获得了一个数据转储，所有记录都没有特别的顺序。我使用了一个select查询并进行表查询，以便将这些数据转换为更易理解的记录集。相关字段是CSR（它是唯一的，没有重复），CONSUMER_ID（每个消费者都是唯一的，但由于一个消费者可以有多个呼叫，因此有重复），CsrModel，CsrSerialNumber，CsrCallDate，RepairDate和RepeatBoolean。

我被告知要按三个字段对记录进行分组：CONSUMER_ID，CsrModel和CsrSerialNumber。因此，当您拉出表格时，例如，CONSUMER_ID可能会出现3次，同时匹配相同的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

使用杰里科解决方案的当前代码，但仍未捕获所有内容：

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

Updated code

最终编辑＃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
vba ms-access
1个回答
2
投票

虽然可能有不同的方法来实现您的预​​期结果，但您当前代码的问题的关键在于，通过使用GoTo FirstLoop命令，您绕过了Do Until rs.EOF线应该执行的EOF检查。因此，你的代码IS实际上循环遍历所有记录，你的一个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
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.