Rs.MoveNextのエラーとレコードの重複

Question

ボタンを使用してあるテーブルから別のテーブルにレコードをコピーできるフォームがあります。私はレコードをコピーするのに役立つクエリを作成しました。

IDを自分の一意のIDに変更することにしました。しかし、私のレコードは重複し続け、私は自分のrs.MoveNextでランタイムエラー3071を取得し続けます。

どこが間違っていますか？

Private Sub Save_Click() 

Dim rs As Recordset 
Dim sql As String 
Dim lastdate As String 
Dim lastyear As Double 
Dim lastid As String 
Dim currentid As String 
Dim a As Integer 

sql = "select top 1 * from 2_WIP order by Date_Recorded DESC" 
Set rs = CurrentDb.OpenRecordset(sql) 

If rs.EOF Then 
    lastdate = "01/1/1990" 
    lastyear = 1990 
    lastid = 0 
Else 
    lastdate = DateValue(rs!Date_Recorded) 
    lastyear = Year(rs!Date_Recorded) 
    lastid = Val(Mid(rs!RecordID, 6)) 
End If 

sql = "select * from 1_Daily_Entry where datevalue(Date_Recorded)>= '" & lastdate & "' and year(Date_Recorded) >= '" & lastyear & "';" 
Set rs = CurrentDb.OpenRecordset(sql) 

Do While Not rs.EOF 
    If DateValue(rs!Date_Recorded) = lastdate Then 
      a = Year(rs!Date_Recorded) 
       If (a = lastyear) Then 
        lastid = lastid + 1 
       Else 
        lastid = 1 
        lastyear = a 
       End If 
        currentid = a & "_" & lastid 
        If rs!S1_Good_Count = 0 Then 
         DoCmd.Close 
        ElseIf rs!S2_Good_Count = 0 Then 
         DoCmd.Close 
        ElseIf rs!S3_Good_Count = 0 Then 
         DoCmd.Close 
        Else 
         sql = "insert into 2_WIP (RecordID, Date_Recorded, Product, S1_Good_Count, S2_Good_Count, S3_Good_Count) values ('" & currentid & "', '" & rs!Date_Recorded & "', '" & rs!Product & "', '" & rs!S1_Good_Count & "', '" & rs!S2_Good_Count & "', '" & rs!S3_Good_Count & "')" 
         CurrentDb.Execute (sql) 
         DoCmd.Close 
        End If 

    Else 
     a = Year(rs!Date_Recorded) 
     If (a = lastyear) Then 
      lastid = lastid + 1 
     Else 
      lastid = 1 
      lastyear = a 
     End If 
      currentid = a & "_" & lastid 
      If rs!S1_Good_Count = 0 Then 
       DoCmd.Close 
      ElseIf rs!S2_Good_Count = 0 Then 
       DoCmd.Close 

      ElseIf rs!S3_Good_Count = 0 Then 
       DoCmd.Close 
      Else 
       sql = "insert into 2_WIP (RecordID, Date_Recorded, Product, S1_Good_Count, S2_Good_Count, S3_Good_Count) values ('" & currentid & "', '" & rs!Date_Recorded & "', '" & rs!Product & "', '" & rs!S1_Good_Count & "', '" & rs!S2_Good_Count & "', '" & rs!S3_Good_Count & "')" 
       CurrentDb.Execute (sql) 
       DoCmd.Close 
      End If 
     End If 

rs.MoveNext *error keeps highlighting at this line* 
Loop 

End Sub 

Answer 1

私と同様の問題を抱えている人のための解決策が見つかりました。

Link for Answer to Question