What is wrong with my record count

M

manusri

Registered User.
Local time
Today, 12:04
Joined
Dec 31, 2012
Messages
29
Hi,
so i have this database that has unbound forms and unbound subforms (not my choice but, have to go with it). So i have a subform that has a listbox that pulls out a list of vendors from table1 which is store in subform1. Now this subform: subform 2 records the vendor's license info etc on it which is unbound as well. the information on subform2 is stored in table 2. The main form for both subforms are not the same as they are stored in a different section of the database.

I am having issues with the SAVE button. When a user clicks on the listbox, the subform loads with the corresponding contact names to that vendor list. But after filling out one of the fields on the subform and hitting SAVE button, the values are saved. but, say i change a value and click save, a new record is created on the table. i dont know how to set it right. can you guys help me. Please find code below and the image of the subform attached.

Code: 
Private Sub Save_Click()
On Error GoTo cmd_Save_Click_Err

    On Error Resume Next
    
    Dim db As Database
    Set db = CurrentDb
    Dim rs As DAO.Recordset
    Dim rsC As DAO.Recordset
    Dim rs2 As DAO.Recordset
    Dim SQLStr As String
    Dim SQLStrC As String
    Dim SQLStrU As String

    Dim rcount As Integer
    Dim log As Integer
    Dim LCode As Integer
    
    SQLStrC = "SELECT Count(*) FROM TMFStaffQual LEFT JOIN Contacts ON TMFStaffQual.ContactsId = Contacts.ContactId" & _
    "WHERE TMFStaffQual.TMFStaffQualID = " & Me.lstContacts.Value
    Set rsC = db.OpenRecordset(SQLStrC, dbOpenDyanset)

    rsC.MoveFirst
    rcount = rsC.Fields(0).Value
    rsC.Close
    Set rsC = Nothing
    
    SQLStr = "SELECT TMFStaffQual.TMFStaffQualID, TMFStaffQual.SiteId, TMFStaffQual.FDstat" & _
             "FROM TMFStaffQual LEFT JOIN Contacts ON TMFStaffQual.ContactsId = Contacts.ContactID" & _
             ", TMFStaffQual.FDdt, TMFStaffQual.CVstat, TMFStaffQual.CVdt, TMFStaffQual.CVexpdt" & _
            "WHERE TMFStaffQual.SiteId = " & Me.Parent!txtNewSiteId.Value & " AND TMFStaffQual.TMFStaffQualID = " & Me.lstContacts.Value
       
    Set rs = db.OpenRecordset(SQLStr, dbOpenDynaset)
    rs.Close

 If rcount > 1 Then
    ElseIf rcount = 0 Then
           
        Set rs2 = db.OpenRecordset("TMFStaffQual")
            With rs2
            
            .AddNew
                ![siteid] = Me.Parent!txtNewSiteId.Value
                ![ContactsId] = Me.lstContacts.Value
                ![FDstat] = Me.txtFD.Value
                ![FDdt] = Me.txtFDdt.Value
                ![CVstat] = Me.txtCV.Value
                ![CVdt] = Me.txtCVdt.Value
                ![CVexpdt] = Me.txtCVexp.Value
                ![Lstat] = Me.txtLic.Value
                ![State] = Me.txtst.Value
                ![LNum] = Me.txtLnum.Value
                ![Lexpdt] = Me.txtLexp.Value
                ![Sign] = Me.txtSign.Value
                ![Signdt] = Me.txtSigndt.Value
                ![Train] = Me.txtTrain.Value
                ![Traindt] = Me.txtTrdt.Value
                ![EDC] = Me.txtEDC.Value
                ![EDCdt] = Me.txtEDCdt.Value
                ![PFT] = Me.txtPFT.Value
                ![PFTdt] = Me.txtPFTdt.Value
            .Update
            
            End With
        
        rs2.Close
        Set rs2 = Nothing
       MsgBox ("Record is saved")
     
     SQLStrO = "UPDATE Contacts Set [Corder] = " & "'" & txtorder.Value & "'" & " WHERE Contacts.ContactID = " & Me.lstContacts.Value
        db.Execute SQLStrO
                

        rs2.Close
        Set rs2 = Nothing
    
    Else

    
        SQLStrU = "UPDATE TMFStaffQual SET [Fdstat] = " & "'" & Me.txtFD.Value & "'" & ", [FDdt] = " & "'" & Me.txtFDdt.Value & "'" & _
            ", [CVstat] = " & "'" & Me.txtCV.Value & "'" & ", [CVdt] = " & "'" & Me.txtCVdt.Value & "'" & ", [CVexpdt] = " & "'" & Me.txtCVexp.Value & "'" & _
            ", [Lstat] = " & "'" & Me.txtLic.Value & "'" & ", [State] = " & "'" & Me.txtst.Value & "'" & ",[LNum] = " & "'" & Me.txtLnum.Value & "'" & _
            ", [Lexpdt] = " & "'" & Me.txtLexp.Value & "'" & ", [Sign] = " & "'" & Me.txtSign.Value & "'" & _
            ", [Signdt] = " & "'" & Me.txtSigndt.Value & "'" & ", [Train] = " & "'" & Me.txtTrain.Value & "'" & ", [Traindt] = " & "'" & Me.txtTrdt.Value & "'" & _
            ", [EDC] = " & "'" & Me.txtEDC.Value & "'" & ", [EDCdt] = " & "'" & Me.txtEDCdt.Value & "'" & ", [PFT] = " & "'" & Me.txtPFT.Value & "'" & _
            ", [PFTdt] = " & "'" & Me.txtPFTdt.Value & "'" & " WHERE TMFStaffQual.TMFStaffQualID = " & Me.lstContacts.Value
        db.Execute SQLStrU
               'TMFStaffQual.TMFStaffQualID = " & Me.lstContacts.Value & " AND  TMFStaffQual.SiteId = " & Me.Parent!txtNewSiteId.Value
    MsgBox ("Record is updated")
    
    End If
    
    db.Close

cmd_Save_Click_Exit:
    Exit Sub

cmd_Save_Click_Err:
    MsgBox Error$
    Resume cmd_Save_Click_Exit

End Sub

Please help:banghead:
 

Attachments

  • subform.png
    subform.png
    17.8 KB · Views: 120
First, comment out the error handling in the code, because it preventing you from seeing what happens if an error occurs, (do always this if you can't get the rode to run the way you expect it), and the one you have is one of the worst.
"On Error Resume Next", you'll never discover any error, because the program goes to the next line if an error occur.
You have also some code which is redundant, because you do not use the result.
You have 2 error handling just after each other, 1 is enough and the last one is which take effect.
Code: 
On Error GoTo cmd_Save_Click_Err 
    On Error Resume Next
You are missing a space in the below line, between the "Contacts.ContactId" & _ "WHERE", (and it is here the error occurs):
SQLStrC = "SELECT Count(*) FROM TMFStaffQual LEFT JOIN Contacts ON TMFStaffQual.ContactsId = Contacts.ContactId" & _ "WHERE TMFStaffQual.TMFStaffQualID = " & Me.lstContacts.Value
Click to expand...
Correct is:
SQLStrC = "SELECT Count(*) FROM TMFStaffQual LEFT JOIN Contacts ON TMFStaffQual.ContactsId = Contacts.ContactId " & _ "WHERE TMFStaffQual.TMFStaffQualID = " & Me.lstContacts.Value
Click to expand...
Code you don't use the result from, because you close the recordset just after you have set it, (also here you are missing the leading spaces):
SQLStr = "SELECT TMFStaffQual.TMFStaffQualID, TMFStaffQual.SiteId, TMFStaffQual.FDstat" & _
"FROM TMFStaffQual LEFT JOIN Contacts ON TMFStaffQual.ContactsId = Contacts.ContactID" & _
", TMFStaffQual.FDdt, TMFStaffQual.CVstat, TMFStaffQual.CVdt, TMFStaffQual.CVexpdt" & _
"WHERE TMFStaffQual.SiteId = " & Me.Parent!txtNewSiteId.Value & " AND TMFStaffQual.TMFStaffQualID = " & Me.lstContacts.Value
Set rs = db.OpenRecordset(SQLStr, dbOpenDynaset)
rs.Close
Click to expand...
Go critically through your code and remove all unnecessary the above is only an example, there are more.
 
So i did what you asked me to and saved my program. but, now if i hit the save button, there is an error "Invalid Argument" that pops up but, i don't know which argument it is referring to now. can you help me. See code below.

Code: 
Private Sub Save_Click()
On Error GoTo cmd_Save_Click_Err
    
    Dim db As Database
    Set db = CurrentDb
    Dim rs As DAO.Recordset
    Dim rsC As DAO.Recordset
    Dim rs2 As DAO.Recordset
    Dim SQLStr As String
    Dim SQLStrC As String
    Dim SQLStrU As String

    Dim rcount As Integer
    Dim log As Integer
    Dim LCode As Integer
    
    SQLStrC = "SELECT Count(*) FROM TMFStaffQual LEFT JOIN Contacts ON TMFStaffQual.ContactsId = Contacts.ContactId" & _
    " WHERE TMFStaffQual.SiteId = " & Me.Parent!txtNewSiteId.Value & " AND TMFStaffQual.TMFStaffQualID = " & Me.lstContacts.Value
    Set rsC = db.OpenRecordset(SQLStrC, dbOpenDyanset)
    rcount = rsC.RecordCount

 If rcount > 1 Then
    ElseIf rcount = 0 Then
           
        Set rs2 = db.OpenRecordset("TMFStaffQual")
            With rs2
            .AddNew
                ![siteid] = Me.Parent!txtNewSiteId.Value
                ![ContactsId] = Me.lstContacts.Value
                ![FDstat] = Me.txtFD.Value
                ![FDdt] = Me.txtFDdt.Value
                ![CVstat] = Me.txtCV.Value
                ![CVdt] = Me.txtCVdt.Value
                ![CVexpdt] = Me.txtCVexp.Value
                ![Lstat] = Me.txtLic.Value
                ![State] = Me.txtst.Value
                ![LNum] = Me.txtLnum.Value
                ![Lexpdt] = Me.txtLexp.Value
                ![Sign] = Me.txtSign.Value
                ![Signdt] = Me.txtSigndt.Value
                ![Train] = Me.txtTrain.Value
                ![Traindt] = Me.txtTrdt.Value
                ![EDC] = Me.txtEDC.Value
                ![EDCdt] = Me.txtEDCdt.Value
                ![PFT] = Me.txtPFT.Value
                ![PFTdt] = Me.txtPFTdt.Value
            .Update
            
            End With
        
        rs2.Close
        Set rs2 = Nothing
       MsgBox ("Record is saved")
     
     SQLStrO = "UPDATE Contacts Set [Corder] = " & "'" & txtorder.Value & "'" & " WHERE Contacts.ContactID = " & Me.lstContacts.Value
        db.Execute SQLStrO
                
        rs2.Close
        Set rs2 = Nothing
    
    ElseIf rcount = 1 Then

    
        SQLStrU = "UPDATE TMFStaffQual SET [Fdstat] = " & "'" & Me.txtFD.Value & "'" & ", [FDdt] = " & "'" & Me.txtFDdt.Value & "'" & _
            ", [CVstat] = " & "'" & Me.txtCV.Value & "'" & ", [CVdt] = " & "'" & Me.txtCVdt.Value & "'" & ", [CVexpdt] = " & "'" & Me.txtCVexp.Value & "'" & _
            ", [Lstat] = " & "'" & Me.txtLic.Value & "'" & ", [State] = " & "'" & Me.txtst.Value & "'" & ",[LNum] = " & "'" & Me.txtLnum.Value & "'" & _
            ", [Lexpdt] = " & "'" & Me.txtLexp.Value & "'" & ", [Sign] = " & "'" & Me.txtSign.Value & "'" & _
            ", [Signdt] = " & "'" & Me.txtSigndt.Value & "'" & ", [Train] = " & "'" & Me.txtTrain.Value & "'" & ", [Traindt] = " & "'" & Me.txtTrdt.Value & "'" & _
            ", [EDC] = " & "'" & Me.txtEDC.Value & "'" & ", [EDCdt] = " & "'" & Me.txtEDCdt.Value & "'" & ", [PFT] = " & "'" & Me.txtPFT.Value & "'" & _
            ", [PFTdt] = " & "'" & Me.txtPFTdt.Value & "'" & " WHERE TMFStaffQual.TMFStaffQualID = " & Me.lstContacts.Value
        db.Execute SQLStrU
               'TMFStaffQual.TMFStaffQualID = " & Me.lstContacts.Value & " AND  TMFStaffQual.SiteId = " & Me.Parent!txtNewSiteId.Value
    MsgBox ("Record is updated")
    
    End If
    
    db.Close

cmd_Save_Click_Exit:
    Exit Sub

cmd_Save_Click_Err:
    MsgBox Error$
    Resume cmd_Save_Click_Exit

End Sub
 
One more thing, if i insert the
Code: 
 On Error Resume Next
statement now, it again goes back to doing the same old thing... saving every entry and it does not check if the entry is new or update of a previous value. so i believe my "Invalid Argument" is referring to the statements below.
Code: 
    SQLStrC = "SELECT Count(*) FROM TMFStaffQual LEFT JOIN Contacts ON TMFStaffQual.ContactsId = Contacts.ContactId" & _
    " WHERE TMFStaffQual.SiteId = " & Me.Parent!txtNewSiteId.Value & " AND TMFStaffQual.TMFStaffQualID = " & Me.lstContacts.Value
    Set rsC = db.OpenRecordset(SQLStrC, dbOpenDyanset)
    rcount = rsC.RecordCount

rcount is used to help it decide if the data entered is new or if it is being updated. Now... i have done this many times but,I dont know why my count is not working....Help me please
 
Comment out the below line, then you know exactly in which line the error occur, (show us the line and the error code and error message ex. by a print screen).
Code: 
On Error GoTo cmd_Save_Click_Err
Else post your database with some sample data, (zip it).

manusri said:
One more thing, if i insert the
Code: 
 On Error Resume Next
statement now, it again goes back to doing the same old thing... saving every entry and it does not check if the entry is new or update of a previous value. so i believe my "Invalid Argument" is referring to the statements below.
Click to expand...
Exactly what i mention before, it is one of the worst error handling you can do, because the program goes to the next line in the code, if an error occur.
 
Last edited:
Sorry i did not understand you the first time... Now i see the error- "Invalid Argument" on the line
Code: 
    Set rsC = db.OpenRecordset(SQLStrC, dbOpenDyanset)
from
Code: 
    SQLStrC = "SELECT Count(*) FROM TMFStaffQual" & _
    " WHERE TMFStaffQual.SiteId = " & Me.Parent!txtNewSiteId.Value & " AND TMFStaffQual.TMFStaffQualID = " & Me.lstContacts.Value
    Set rsC = db.OpenRecordset(SQLStrC, dbOpenDyanset)
 rsC.MoveFirst
    rcount = rsC.Fields(0).Value
    rsC.Close
    Set rsC = Nothing
 
So i removed the "options " in the OpenRecordset statment and the error was removed. But, i still seems to save all records as new records instead of updating them...

Code: 
Private Sub Save_Click()

    
    Dim db As Database
    Set db = CurrentDb
    Dim rs As DAO.Recordset
    Dim rsC As DAO.Recordset
    Dim rs2 As DAO.Recordset
    Dim SQLStr As String
    Dim SQLStrC As String
    Dim SQLStrU As String

    Dim rcount As Integer
    Dim log As Integer
    Dim LCode As Integer

    SQLStrC = "SELECT Count(*) FROM TMFStaffQual" & _
    " WHERE TMFStaffQual.SiteId = " & Me.Parent!txtNewSiteId.Value & " AND TMFStaffQual.TMFStaffQualID = " & Me.lstContacts.Value
    Set rsC = db.OpenRecordset(SQLStrC)

    rsC.MoveFirst
    rcount = rsC.Fields(0).Value
    rsC.Close
    Set rsC = Nothing
    
   If rcount = 0 Then
           
        Set rs2 = db.OpenRecordset("TMFStaffQual")
            With rs2
            .AddNew
                ![siteid] = Me.Parent!txtNewSiteId.Value
                ![ContactsId] = Me.lstContacts.Value
                ![FDstat] = Me.txtFD.Value
                ![FDdt] = Me.txtFDdt.Value
                ![CVstat] = Me.txtCV.Value
                ![CVdt] = Me.txtCVdt.Value
                ![CVexpdt] = Me.txtCVexp.Value
                ![Lstat] = Me.txtLic.Value
                ![State] = Me.txtst.Value
                ![LNum] = Me.txtLnum.Value
                ![Lexpdt] = Me.txtLexp.Value
                ![Sign] = Me.txtSign.Value
                ![Signdt] = Me.txtSigndt.Value
                ![Train] = Me.txtTrain.Value
                ![Traindt] = Me.txtTrdt.Value
                ![EDC] = Me.txtEDC.Value
                ![EDC_dt] = Me.txtEDCdt.Value
                ![PFT] = Me.txtPFT.Value
                ![PFTdt] = Me.txtPFTdt.Value
            .Update
            
            End With
        
        rs2.Close
        Set rs2 = Nothing
       MsgBox ("Record is saved")
     

    Else

    
        SQLStrU = "UPDATE TMFStaffQual SET [Fdstat] = " & "'" & Me.txtFD.Value & "'" & ", [FDdt] = " & "'" & Me.txtFDdt.Value & "'" & _
            ", [CVstat] = " & "'" & Me.txtCV.Value & "'" & ", [CVdt] = " & "'" & Me.txtCVdt.Value & "'" & ", [CVexpdt] = " & "'" & Me.txtCVexp.Value & "'" & _
            ", [Lstat] = " & "'" & Me.txtLic.Value & "'" & ", [State] = " & "'" & Me.txtst.Value & "'" & ",[LNum] = " & "'" & Me.txtLnum.Value & "'" & _
            ", [Lexpdt] = " & "'" & Me.txtLexp.Value & "'" & ", [Sign] = " & "'" & Me.txtSign.Value & "'" & _
            ", [Signdt] = " & "'" & Me.txtSigndt.Value & "'" & ", [Train] = " & "'" & Me.txtTrain.Value & "'" & ", [Traindt] = " & "'" & Me.txtTrdt.Value & "'" & _
            ", [EDC] = " & "'" & Me.txtEDC.Value & "'" & ", [EDCdt] = " & "'" & Me.txtEDCdt.Value & "'" & ", [PFT] = " & "'" & Me.txtPFT.Value & "'" & _
            ", [PFTdt] = " & "'" & Me.txtPFTdt.Value & "'" & " WHERE TMFStaffQual.TMFStaffQualID = " & Me.lstContacts.Value
        db.Execute SQLStrU
               'TMFStaffQual.TMFStaffQualID = " & Me.lstContacts.Value & " AND  TMFStaffQual.SiteId = " & Me.Parent!txtNewSiteId.Value
    MsgBox ("Record is updated")
    
    End If
    
    db.Close

End Sub
 
Then place a break point in your code and step thought it, and see if SQLStrC looks like how you inspect it, (Debug.Print (SQLStrC))

Else post your database with some sample data, (zip it).
 
You must log in or register to reply here.

Users who are viewing this thread

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