Невозможно перебрать весь набор записей

Question

Я пытаюсь запустить этот бит кода через кнопку, я впервые использую VBA, и я не уверен, почему я получаю эту ошибку:

Ошибка времени выполнения «3021»: нет текущей записи.

В этой строке кода:

ConsumerID_1 = rs!CONSUMER_ID

Набор записей содержит 26 тыс. Записей, при первом нажатии кнопки он работал, но при повторном нажатии появляется ошибка.

Вот мой код:

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

Снимок таблицы в текущей форме и Снимок таблицы в текущей форме

Некоторые записи были успешно захвачены, а другие полностью пропущены.

Уточню дальше, мне изначально дали дамп данных со всеми записями в произвольном порядке. Я использовал запрос 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

Обновленный код

Окончательное редактирование # 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

Answer 1

Несмотря на то, что может быть другой способ достичь желаемых результатов, суть проблемы с вашим текущим кодом заключается в том, что с помощью команд GoTo FirstLoop вы обходите EOF, проверяя, что строка Do Until rs.EOF должна выполнять. Таким образом, ваш код фактически проходит по всем записям, и одна из ваших rs.MoveNext строк приводит к тому, что набор записей попадает в 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

Исходя из дополнительных вопросов в комментариях ФП, следующий код должен предоставить ожидаемые результаты.

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