VBA Error 3021 No Current record

[Gordo]

Has anyone ever done something like this, either update a record or add a new record?

I'm trying to update my inventory file. If the item is in inventory, I update it, if it's not in inventory, I want to add it as a new item. The code I have gives me a no current record error when I need to add a new record. I understand it is because I'm trying to access data with nothing in the recordset. Unfortunately I need to select the recordset or else I get a mismatch on my item numbers. This should be a simple problem, but I've tried numerous times to get it working to no avail.


Dim I As Integer
Dim Findquery As String
Dim db As Database
Dim rs As Recordset
Dim rs2 As Recordset

Set rs = Nothing
Set rs2 = Nothing

Set db = CurrentDb
'Set rs2 = db.OpenRecordset("Inv_Recd2")
Set rs2 = db.OpenRecordset("Select* from Inv_Recd2 order by ItemNum")

'Set rs = db.OpenRecordset("Inv_Recd")
Set rs = db.OpenRecordset("Select* from Inv_Recd order by ItemNum")
rs.MoveFirst

' loop through table Inv_Recd looking for ItemNumbers in Inv_Recd2. If the item number
' is found then edit the record with new info. If item number is not found, add a new record.

Do
Set rs2 = db.OpenRecordset("SELECT * from Inv_Recd2 WHERE [ItemNum] = '" & rs!ItemNum & "'")
If IsNull(DLookup("ItemNum", "Inv_Recd2", rs!ItemNum = rs2!ItemNum)) Then
rs2.AddNew
rs2.Fields("ItemNum") = rs.Fields("ItemNum")
rs2.Fields("ItemName") = rs.Fields("ItemName")
rs2.Fields("Cost") = rs.Fields("Cost")
rs2.Fields("Received") = rs.Fields("Received")
rs2.Fields("Price") = rs.Fields("Price")
rs2.Fields("Dept") = rs.Fields("Dept")
rs2.Fields("RPrice") = rs.Fields("RPrice")
rs2.Update
Else
Set rs2 = db.OpenRecordset("SELECT * from Inv_Recd2 WHERE [ItemNum] = '" & rs!ItemNum & "'")
rs2.Edit
rs2.Fields("ItemNum") = rs.Fields("ItemNum")
rs2.Fields("ItemName") = rs.Fields("ItemName")
rs2.Fields("Cost") = rs.Fields("Cost")
rs2.Fields("Received") = rs2.Fields("Received") + rs.Fields("Received")
rs2.Fields("Price") = rs.Fields("Price")
rs2.Fields("Dept") = rs.Fields("Dept")
rs2.Fields("RPrice") = rs.Fields("RPrice")
rs2.Update
End If
On Error GoTo Errhandler
rs.MoveNext
Loop Until rs.EOF

Errhandler:
If Errors.Count > 1 Then
For Each errX In DAO.Errors
Debug.Print "ODBC Error"
Debug.Print Err.Number
Debug.Print Err.Description
Next errX
Else
Debug.Print "VBA Error"
Debug.Print Err.Number
Debug.Print Err.Description
End If

rs.Close
Set rs = Nothing
rs2.Close
Set rs2 = Nothing
db.Close
Set db = Nothing

End Sub

 

[namliam]

Where are you getting the error? Only place logical I can see at the moment is at ths rs.Movefirst, which I dont think would make sence.

Please use code wraps around code to preserve the formatting/spacing by clicking the # button on the post menu or typing [cade] and [/cade] around the code (offcourse substituting the a by an o

 

[Gordo]

I get the error when I execute this line of code:

Do
     Set rs2 = db.OpenRecordset("SELECT * from Inv_Recd2 WHERE [ItemNum] = '" & rs!ItemNum & "'")

because I've come to a record that is not in my second table...that's why I am attempting to add it.

If I don't have this line of code, when my rs moves to the next record, I can't locate the that record in my rs2 file.

 

[namliam]

No current record usually is encountered at rs.movenext or simular lines
Though I dont quite get why you are doing what you are doing in the order you are doing it...

Do
Set rs2 = db.OpenRecordset("SELECT * from Inv_Recd2 WHERE [ItemNum] = '" & rs!ItemNum & "'")
If IsNull(DLookup("ItemNum", "Inv_Recd2", rs!ItemNum = rs2!ItemNum)) Then

Would be more logical to do something like:

Do
    If IsNull(DLookup("ItemNum", "Inv_Recd2", rs!ItemNum = rs2!ItemNum)) Then
        Set rs2 = db.OpenRecordset("Inv_Recd2")

Since you already know the item number doesnt exist.

On the second notice, your DLookup is flawed...

If IsNull(DLookup("ItemNum", "Inv_Recd2", rs!ItemNum = rs2!ItemNum)) Then

It should read something like:

If IsNull(DLookup("ItemNum", "Inv_Recd2", "[ItemNum] = '" & rs!ItemNum & "'")) Then