Editing Recordsets W/ VBA

X

xcrx

Edge
Local time
Today, 10:06
Joined
Oct 21, 2009
Messages
80
I am working on a piece of code that takes a bar code as input and modifies the related record. It all seemed to be working okay but I have found that if you scan the same bar code twice it gives you an error about the record not being able to be edited because someone else is editing it. It fails on rst.Update. After researching the problem I can't seem to fix it. Below is the portion of my code that I am having problems with. Any help would be greatly appreciated.

Code: 
Set rst = CurrentDb.OpenRecordset("Work_Details_tbl")
                rst.FindFirst "Tracking_num = " & Chr(34) & Scan & Chr(34)
                If rst.NoMatch Then
                    MsgBox "Incorect Entry"
                Else
                
                Realqty = InputBox("Enter quantity for part # " & rst!Part_Num & " on job # " & rst!Job_Num, "Enter Quantity", rst!Part_Qty)
                
                rst.Edit
                rst!Part_Status = "Recieved"
                rst!Part_Completed = DLookup("init", "Users_tbl", "IDNumber = " & Usern)
                rst!Part_Comp_Date = Date
                rst!Part_Qty = Realqty
                rst.Update
                rst.Close
                Set rst = Nothing
                Scan = ""
                Beep
                Me.BarCode.SetFocus
 
The default for OpenRecordset is a table. Start by specifying a Dynaset:
Set rst = CurrentDb.OpenRecordset("Work_Details_tbl", dbOpenDynaset)
 
I specified the record set as a dynaset but it still acts the same as before.
 
Post the entire procedure from Private...to...End Sub, please.
 
No problem. It is a long one and not too much of it is commented. Basically It runs after a text field is updated on my form. The conditions are based on radio buttons on the form. Let me know if you need any more info on it.

Code: 
Private Sub BarCode_AfterUpdate()

Dim rst As DAO.Recordset
Dim rst1 As DAO.Recordset
Dim part As String
Scan = Me.BarCode
Me.BarCode = ""


'Work Order

If Me.Check2 = True Then
    DoCmd.Close acForm, "Barcode_frm", acSaveNo
    DoCmd.OpenForm "Work_Orders_frm"

    If Not IsNull(Scan) Then
        Set rst = Forms!Work_Orders_frm.RecordsetClone
        rst.FindFirst "Job_Num = " & Chr(34) & Scan & Chr(34)
        If Not rst.NoMatch Then
            Forms!Work_Orders_frm.Bookmark = rst.Bookmark
        Else
            MsgBox "Not Found! Really? How did you do that?"
        End If
    'clear out the search field for the next search
        Scan = ""
        Forms!Work_Orders_frm.Status = "Done"
        Forms!Work_Orders_frm.Job_Completed = DLookup("init", "Users_tbl", "IDNumber = " & Usern)
        Forms!Work_Orders_frm.Job_Comp_Date = Date
        MsgBox "Enter lost quantities in the ""Lost"" field. Add extra  quantites in the ""Qty"" field. If you add to the ""Qty"" field, please  press ""Check Quantities"" at the top of the form.", vbInformation,  "Finish the Job"
    End If
    rst.Close
    Set rst = Nothing
Else

'Parts Finished

    If Me.Check6 = True Then
        Dim Realqty As Integer
        Dim Lost As Integer
        
            Set rst = CurrentDb.OpenRecordset("Work_Details_tbl")
               rst.FindFirst "Tracking_num = " & Chr(34) & Scan & Chr(34)
        
        Realqty = InputBox("Enter quantity for part # " &  rst!Part_Num & " on job # " & rst!Job_Num, "Enter Quantity",  rst!Part_Qty)
        
        If Realqty < rst!Part_Qty Then
            Lost = rst!Part_Qty - Realqty
            If Lost <= rst!Qty_Added And rst!Qty_Added <> 0 Then
                DoCmd.SetWarnings False
                DoCmd.RunSQL "INSERT INTO OD_Sin_tbl ( OrderNumber,  SigOrderPartNumber, SigOrderQuantity, Hot )SELECT 98 AS OrderNumber, "  & Chr(34) & rst!Part_Num & Chr(34) & " As  SigOrderPartNumber, " & (Lost * -1) & " As SigOrderQuantity, 0  AS Hot;"
                
                rst.Edit
                rst!Qty_Added = (rst!Qty_Added - Lost)
                rst.Update
                DoCmd.SetWarnings True
            End If
            rst.Edit
            rst!Lost = Lost
            rst.Update
        Else
            If Realqty > rst!Part_Qty Then
                OnOrder = DLookup("[On_Order]", "[On_Order_qry]",  "[Partnumber] = " & Chr(34) & rst!Part_Num & Chr(34))
                If OnOrder - (Realqty - rst!Part_Qty) < 0 Then
                    DoCmd.RunSQL "INSERT INTO OD_Sin_tbl ( OrderNumber,  SigOrderPartNumber, SigOrderQuantity, Hot )SELECT 99 AS OrderNumber, "  & Chr(34) & rst!Part_Num & Chr(34) & " As  SigOrderPartNumber, " & (Realqty - rst!Part_Qty) & " As  SigOrderQuantity, 0 AS Hot;"
                    rst.Edit
                    rst!Qty_Added = rst!Qty_Added + (Realqty - rst!Part_Qty)
                    rst.Update
                End If
                rst.Edit
                rst!Part_Qty = Realqty
                rst.Update
            End If
        End If
        rst.Edit
        rst!Part_Status = "For Delivery"
        rst!Part_Completed = DLookup("init", "Users_tbl", "IDNumber = " & Usern)
        rst!Part_Comp_Date = Date
        rst.Update
        Scan = ""
        rst.Close
        Beep
        Me.BarCode.SetFocus
    Else
    
'Parts Delivered
    
        If Me.Check8 = True Then
            Set rst = CurrentDb.OpenRecordset("Delivery_Detail_tbl")
            Set rst1 = CurrentDb.OpenRecordset("Work_Details_tbl")
            Do Until rst.EOF = True
                If rst!DeliveryID = Scan Then
                    rst1.FindFirst "Tracking_num = " & Chr(34) & rst!Tracking_Num & Chr(34)
                    rst1.Edit
                    rst1!Part_Status = "Delivered"
                    rst1!Part_Completed = DLookup("init", "Users_tbl", "IDNumber = " & Usern)
                    rst1!Part_Comp_Date = Date
                    rst1.Update
                End If
            rst.MoveNext
            Loop
            MsgBox "Done"
            Scan = ""
            rst.Close
            Beep
            Me.BarCode.SetFocus
        Else
        
'Parts Recieved
        
            If Me.Check10 = True Then
            
                Set rst = CurrentDb.OpenRecordset("Work_Details_tbl", dbOpenDynaset)
                'rst.Open "Work_Details_tbl", CurrentProject.Connection, adOpenStatic, adLockBatchOptimistic
                rst.FindFirst "Tracking_num = " & Chr(34) & Scan & Chr(34)
                If rst.NoMatch Then
                    MsgBox "Incorect Entry"
                Else
                
                Realqty = InputBox("Enter quantity for part # " &  rst!Part_Num & " on job # " & rst!Job_Num, "Enter Quantity",  rst!Part_Qty)
                
                rst.Edit
                rst!Part_Status = "Recieved"
                rst!Part_Completed = DLookup("init", "Users_tbl", "IDNumber = " & Usern)
                rst!Part_Comp_Date = Date
                rst!Part_Qty = Realqty
                rst.Update
                rst.Close
                Set rst = Nothing
                Scan = ""
                Beep
                Me.BarCode.SetFocus
                End If
            Else
                MsgBox "No Option Selected. How did you do that?", vbOKOnly, "Ooops!"
            End If
        End If
    End If
End If
End Sub
 
I'll study it for a bit but in the mean time how about putting:
Option Explicit
...at the top of the module and then correct the problems that exposes.
 
Is the current Form bound to a table or query. If table, would you change it to a query of that table please?
 
I added Option Explicit and had one problem come up from doing that but I fixed it. The form that this code runs from is unbound. It is only used to collect the number from the barcode and what type of code it is. The recordsets I define and use the modify the data are based off tables. Should I switch these to queries?
 
Okay good to know. I will work on getting all of them converted over and let you know how it goes.
 
I still have not completely understood your procedure. Still studying.
 
I was hoping that would take care of it but it didn't. I just did a quick test changing over one of my tables to a query but I get the same results.
 
You *are* opening your tables shared, right?
 
Last edited:
Is it just the "Received" code that has problems or do all of the branches exhibit the error? Where else might you have the Work_Details_tbl table open?
 
RuralGuy said:
You *are* opening your tabes shared right?
Click to expand...
I am not sure what you mean by this. If it helps, my tables are on a mysql server .

Is it just the "Received" code that has problems or do all of the branches exhibit the error? Where else might you have the Work_Details_tbl table open?
Click to expand...

No I just tested with finished section and it has the same errors. My Work_Details_tbl is also accessed by my main form that is always open and it could be open in a secondary form as well but at the moment it is not.

Let me know if there are any parts of my code that need explaining. It probably isn't that well written.
 
This is the last bug I am having in my code. Any ideas what could be causing it?
 
I finally found a solution to this problem.

I noticed today that the error only happened if the field I was trying to update didn't change so I just added an If statement check the values and only run if the values were different.
 
I don't know if this is wanted but I made a quick tidy up of it.
Code: 
Private Sub BarCode_AfterUpdate()
 
    Dim rstWO As DAO.Recordset
    Dim part As String
    Scan = Me.BarCode
    Me.BarCode = ""
 
    'Work Order
 
    If Me.Check2 = True Then
        DoCmd.Close acForm, "Barcode_frm", acSaveNo
        DoCmd.OpenForm "Work_Orders_frm"
 
        If Not IsNull(Scan) Then
            Set rstWO = Forms!Work_Orders_frm.RecordsetClone
            rstWO.FindFirst "Job_Num = " & Chr(34) & Scan & Chr(34)
            If Not rstWO.NoMatch Then
                Forms!Work_Orders_frm.Bookmark = rstWO.Bookmark
            Else
                MsgBox "Not Found! Really? How did you do that?"
            End If
            rstWO.Close
        'clear out the search field for the next search
            Scan = ""
            Forms!Work_Orders_frm.Status = "Done"
            Forms!Work_Orders_frm.Job_Completed = DLookup("init", "Users_tbl", "IDNumber = " & Usern)
            Forms!Work_Orders_frm.Job_Comp_Date = Date
            MsgBox "Enter lost quantities in the ""Lost"" field. Add extra  quantites in the ""Qty"" field. If you add to the ""Qty"" field, please  press ""Check Quantities"" at the top of the form.", vbInformation, "Finish the Job"
        End If
    ElseIf Me.Check6 = True Then
        'Parts Finished
        Dim Realqty As Integer
        Dim Lost As Integer
 
        Set rstWO = CurrentDb.OpenRecordset("SELECT * FROM Work_Details_tbl WHERE Tracking_num = " & Chr(34) & Scan & Chr(34), dbOpenDynaset)
        If rstWO.RecordCount = 1 Then
            rstWO.MoveFirst
            Realqty = InputBox("Enter quantity for part # " & rstWO!Part_Num & " on job # " & rstWO!Job_Num, "Enter Quantity", rstWO!Part_Qty)
            rstWO.Edit
            If Realqty < rstWO!Part_Qty Then
                Lost = rstWO!Part_Qty - Realqty
                If Lost <= rstWO!Qty_Added And rstWO!Qty_Added <> 0 Then
                    DoCmd.SetWarnings False
                    DoCmd.RunSQL "INSERT INTO OD_Sin_tbl (OrderNumber,  SigOrderPartNumber, SigOrderQuantity, Hot ) VALUES (98, " & Chr(34) & rstWO!Part_Num & Chr(34) & ", " & (Lost * -1) & ", 0);"
                    rstWO!Qty_Added = (rstWO!Qty_Added - Lost)
                    DoCmd.SetWarnings True
                End If
                rstWO!Lost = Lost
            Else
                If Realqty > rstWO!Part_Qty Then
                    OnOrder = DLookup("[On_Order]", "[On_Order_qry]", "[Partnumber] = " & Chr(34) & rstWO!Part_Num & Chr(34))
                    rstWO.Edit
                    If OnOrder - (Realqty - rstWO!Part_Qty) < 0 Then
                        DoCmd.SetWarnings False
                        DoCmd.RunSQL "INSERT INTO OD_Sin_tbl (OrderNumber,  SigOrderPartNumber, SigOrderQuantity, Hot ) VALUES (99, " & Chr(34) & rstWO!Part_Num & Chr(34) & ", " & (Realqty - rstWO!Part_Qty) & ", 0);"
                        rstWO!Qty_Added = rstWO!Qty_Added + (Realqty - rstWO!Part_Qty)
                        DoCmd.SetWarnings True
                    End If
                    rstWO!Part_Qty = Realqty
                End If
            End If
            rstWO!Part_Status = "For Delivery"
            rstWO!Part_Completed = DLookup("init", "Users_tbl", "IDNumber = " & Usern)
            rstWO!Part_Comp_Date = Date
            rstWO.Update
            Scan = ""
        End If
        rstWO.Close
        Beep
        Me.BarCode.SetFocus
    ElseIf Me.Check8 = True Then
        'Parts Delivered
        Dim rstDD As DAO.Recordset
        Set rstDD = CurrentDb.OpenRecordset("Delivery_Detail_tbl")
        Set rstWO = CurrentDb.OpenRecordset("Work_Details_tbl")
        rstDD.MoveFirst
        Do While Not rstDD.EOF = True
            If rstDD!DeliveryID = Scan Then
                rstWO.FindFirst "Tracking_num = " & Chr(34) & rstDD!Tracking_Num & Chr(34)
                If Not rstWO.NoMatch Then
                    rstWO.Edit
                    rstWO!Part_Status = "Delivered"
                    rstWO!Part_Completed = DLookup("init", "Users_tbl", "IDNumber = " & Usern)
                    rstWO!Part_Comp_Date = Date
                    rstWO.Update
                End If
            End If
            rstDD.MoveNext
        Loop
        MsgBox "Done"
        Scan = ""
        rstWO.Close
        rstDD.Close
        Beep
        Me.BarCode.SetFocus
    ElseIf Me.Check10 = True Then
        'Parts Recieved
        Set rstWO = CurrentDb.OpenRecordset("SELECT * FROM Work_Details_tbl WHERE Tracking_num = " & Chr(34) & Scan & Chr(34), dbOpenDynaset)
        If rstWO.RecordCount = 1 Then
            .MoveFirst
            Realqty = InputBox("Enter quantity for part # " & rstWO!Part_Num & " on job # " & rstWO!Job_Num, "Enter Quantity", rstWO!Part_Qty)
            rstWO.Edit
            rstWO!Part_Status = "Recieved"
            rstWO!Part_Completed = DLookup("init", "Users_tbl", "IDNumber = " & Usern)
            rstWO!Part_Comp_Date = Date
            rstWO!Part_Qty = Realqty
            rstWO.Update
            rstWO.Close
            Scan = ""
            Beep
            Me.BarCode.SetFocus
        Else
            MsgBox "Incorrect Entry"
        End If
        rstWO.Close
    Else
        MsgBox "No Option Selected. How did you do that?", vbOKOnly, "Ooops!"
    End If
    Set rstWO = Nothing
End Sub

Firstly, the If and ElseIf structure is easier to read I think (less unnecessary nesting and End Ifs)
The SQL Insert Statements: I've never tried INSERT INTO table SELECT {values} (not FROM a table). If just inserting values I'd do it the way shown here.
Rather than open a table as a recordset and then findfirst you can open up the table filtered for that record and just use that (if you don't need to find other records in the recordset).
I've renamed the recordsets so it's easier to tell them apart: In the Check8 section rst1 was the equivelant to rst in the other sections. I've named them rstWO (work order) and rstDD (delivery detail) to make it more obvious which is which.
There were a couple of instances of editing, updating, editing, updating the same record. There's no need to do that unless the cursor moves.

Without the tables and forms I can't test it and.
Putting a break point at the start and stepping through it would be enlightening.

What you said later about other forms being open for the same record will probably be the cause of your problems. Is the error message the code bugging out or is it actually an Access error when another form tries to close and save its changes?
 
VilaRestal
I looked over the code you rewrote for me and it does look much simpler than what I wrote so thank you for that. I did get my code all working and I have actually taken out a lot of the extra stuff you mentioned. I am going to keep these methods in mind the next time I need to write anything like this.

The error I was getting was actually from the code but from what I can figure it is the equivalent of the"write conflict error" you get when you try to update a column from a form with the same value that is already in that column. It was an easy fix and I probably should have realized it earlier.

Thanks for cleaning up my code.

Ryan
 
You must log in or register to reply here.

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom