ID value plus 1

[abelingaw]

Ok here's my problem.

What i wanted to do was that if i save the value i enter on my txtbox (txtIDNo) and saves it to my database, the default value should automatically adds 1 or + 1 on it.

I set the field data type to Number and the default value to 10000. I dont want to use Autonumber because i wanted to set the default value.

If i save a new record, the default value 10000 should become 10001 for the new record.
But i dont really know why my code always get an error.

Here's the code:

Public Sub InitData()
On Error GoTo err:
    If rs.State = adStateOpen Then rs.Close
    
    rs.Open "Select * from tblEmp", cn, adOpenKeyset, adLockPessimistic
    If rs.EOF = False Then
        rs.MoveLast
        Me.txtIDNo.Text = rs.Fields("EM_ID").Value + 1
    Else
        Me.txtIDNo.Text = 10000
    End If
    Exit Sub
err:
    MsgBox err.Description, vbCritical, "Error"
    Set rs = Nothing
End Sub

Please, i really dont know what the problem is. Thanks

[AndreRet]

Try the following -

Public Sub InitData()
On Error GoTo err:
    If rs.State = adStateOpen Then rs.Close
 
    rs.Open "Select * from tblEmp", cn, adOpenStatic, adLockPessimistic 'Keyset changed to static
    If rs.BOF = True Or rs.EOF = True Then
       'No records
       txtIDNo.Text = "10000"
       
       rs.Close
       Exit Sub
          Else
       rs.MoveLast
       Dim xIdNo As Integer
       
       xIdNo = rs!EM_ID
       xIdNo = xIdNo + 1
       txtIDNo.Text = xIdNo

       rs.Close
     End If
   
    Exit Sub
err:
    MsgBox err.Description, vbCritical, "Error"
rs.Close    
Set rs = Nothing
End Sub

[abelingaw]

Still got an error.

Error message is:

Arguments are of the wrong type, are out of range or are in conflict with one another.

I dont know if it is on the Database (datatype) or my code.

Any way, I'll just post the entire code for my Add Employee Form

Can u look at it, Thanks.

Dim process As String
Private Sub cmdAdd_Click()

process = "add"

Call Add
Call InitData

End Sub
Private Sub cmdCancel_Click()

Call Form_Load
cmdSave.Enabled = False
cmdAdd.Enabled = True

End Sub

Private Sub cmdClose_Click()

Unload Me

End Sub

Private Sub cmdSave_Click()

On Error Resume Next

cmdAdd.Enabled = True

Call con

If rs.State = adStateOpen Then rs.Close

    rs.Open "Select * from EmpRecord", cn, adOpenKeyset, adLockPessimistic
    
        If txtIDNo.Text = "" Then MsgBox "Please enter Employee ID number.", vbInformation, "Information": txtIDNo.SetFocus: Exit Sub
        If txtfname.Text = "" Then MsgBox "Please enter First Name.", vbInformation, "Information": txtfname.SetFocus: Exit Sub
        If txtmname.Text = "" Then MsgBox "Please enter Middle Initial.", vbInformation, "Information": txtmname.SetFocus: Exit Sub
        If txtlname.Text = "" Then MsgBox "Please enter Last Name.", vbInformation, "Information": txtlname.SetFocus: Exit Sub
        If cboGender.Text = "" Then MsgBox "Please Select Gender.", vbInformation, "Information": cboGender.SetFocus: Exit Sub
        If cboStat.Text = "" Then MsgBox "Please Select Status.", vbInformation, "Information": cboStat.SetFocus: Exit Sub
        If txtAddress.Text = "" Then MsgBox "Please enter Employee's Address.", vbInformation, "Information": txtAddress.SetFocus: Exit Sub
        If cbodept.Text = "" Then MsgBox "Please enter Department.", vbInformation, "Information": txtDept.SetFocus: Exit Sub
        If txtPost.Text = "" Then MsgBox "Please enter Employee's Position.", vbInformation, "Information": txtPost.SetFocus: Exit Sub
        If cboempstat.Text = "" Then MsgBox "Please Select Employee's Status.", vbInformation, "Information": cboempstat.SetFocus: Exit Sub
        If txtrate.Text = "" Then MsgBox "Please enter Employee's Basic Salary Rate.", vbInformation, "Information": txtBasicRate.SetFocus: Exit Sub

With rs

    If process = "add" Then
        

        .Open "select * from EmpRecord", Dbconn, adOpenDynamic, adLockOptimistic
        
        .AddNew
            
            .Fields(0) = txtIDNo.Text
            .Fields(1) = txtfname.Text
            .Fields(2) = txtmname.Text
            .Fields(3) = txtlname.Text
            .Fields(4) = cboGender.Text
            .Fields(5) = cboStat.Text
            .Fields(6) = txtAddress.Text
            .Fields(7) = dtphired.Value
            .Fields(8) = cbodept.Text
            .Fields(9) = txtPost.Text
            .Fields(10) = txtrate.Text
            .Fields(11) = cboempstat.Text
            
        .Update
            MsgBox "Record has been Saved", vbInformation
        
            .Close
            
    Else
        
            .Open "select * from EmpRecord where EmpID = '" & txtIDNo.Text & "'", Dbconn, adOpenDynamic, adLockOptimistic
        
            
                    
                    .Fields(0) = txtIDNo.Text
                    .Fields(1) = txtfname.Text
                    .Fields(2) = txtmname.Text
                    .Fields(3) = txtlname.Text
                    .Fields(4) = cboGender.Text
                    .Fields(5) = cboStat.Text
                    .Fields(6) = txtAddress.Text
                    .Fields(7) = dtphired.Value
                    .Fields(8) = cbodept.Text
                    .Fields(9) = txtPost.Text
                    .Fields(10) = txtrate.Text
                    .Fields(11) = cboempstat.Text
                    
                .Update
                    MsgBox "Record has been Saved", vbInformation
        
            .Close
    End If
End With
        
    Dbconn.Close
   
Call Form_Load

'err:
 '   MsgBox err.Description, vbCritical, "Error"

End Sub

Private Sub Form_Load()

Call con

With rs
    .Open "select * from EmpRecord", Dbconn, adOpenDynamic, adLockOptimistic
    
  If .EOF = False Then
    
        
        .MoveFirst
        
        While .EOF = False
            
            .MoveNext
        Wend
        
    End If
        .Close
    End With
    
    Dbconn.Close
        
txtIDNo.Enabled = False
txtfname.Enabled = False
txtmname.Enabled = False
txtlname.Enabled = False
cboGender.Enabled = False
cboStat.Enabled = False
txtAddress.Enabled = False
dtphired.Enabled = False
cbodept.Enabled = False
txtPost.Enabled = False
txtrate.Locked = True
txtrate.Enabled = False
cboempstat.Enabled = False


txtIDNo.Text = ""
txtfname.Text = ""
txtmname.Text = ""
txtlname.Text = ""
cboGender.Text = ""
cboStat.Text = ""
txtAddress.Text = ""
cbodept.Text = ""
txtPost.Text = ""
cboempstat.Text = ""


cmdAdd.Enabled = True
cmdSave.Enabled = False
cmdCancel.Enabled = True
cmdClose.Enabled = True
cmdBrowse.Enabled = True

dtphired.Value = Date

End Sub

Private Sub Add()

txtIDNo.Enabled = True
txtfname.Enabled = True
txtmname.Enabled = True
txtlname.Enabled = True
cboGender.Enabled = True
cboStat.Enabled = True
txtAddress.Enabled = True
dtphired.Enabled = True
cbodept.Enabled = True
txtPost.Enabled = True
txtrate.Locked = False
txtrate.Enabled = True
cboempstat.Enabled = True


txtIDNo.Text = ""
txtfname.Text = ""
txtmname.Text = ""
txtlname.Text = ""
cboGender.Text = ""
cboStat.Text = ""
txtAddress.Text = ""
cbodept.Text = ""
txtPost.Text = ""
cboempstat.Text = ""


cmdAdd.Enabled = True
cmdSave.Enabled = True
cmdCancel.Enabled = True
cmdClose.Enabled = True

txtIDNo.SetFocus

    
End Sub


Private Sub txtFName_Lostfocus()

txtfname.Text = UCase(Mid(txtfname.Text, 1, 1)) + LCase(Mid(txtfname.Text, 2, 15))

End Sub

Private Sub txtlname_Lostfocus()

txtlname.Text = UCase(Mid(txtlname.Text, 1, 1)) + LCase(Mid(txtlname.Text, 2, 15))

End Sub

Private Sub txtmname_lostfocus()

txtmname.Text = UCase(Mid(txtmname.Text, 1, 1)) + LCase(Mid(txtmname.Text, 2, 15))

End Sub

Private Sub txtrate_KeyPress(KeyAscii As Integer)

Select Case KeyAscii
        Case vbKeyBack
        Case vbKeyDelete
        Case vbKeyReturn
            SendKeys vbTab
        Case 48 To 57
        Case Else
            KeyAscii = 0
    End Select

End Sub

Private Sub txtrate_LostFocus()

If txtrate.Text = vbNullString Then txtrate.Text = FormatNumber(0, 2)
txtrate.Text = FormatNumber(txtrate.Text, 2)

End Sub

Public Sub InitData()
On Error GoTo err:

    If rs.State = adStateOpen Then rs.Close
 
    rs.Open "Select * from EmpRecord", cn, adOpenStatic, adLockPessimistic 'Keyset changed to static
    If rs.BOF = True Or rs.EOF = True Then
    
       'No records
       txtIDNo.Text = "10000"
       
       rs.Close
       Exit Sub
          Else
       rs.MoveLast
       
Dim xIdNo As Integer
       
       xIdNo = rs!EmpID
       xIdNo = xIdNo + 1
       txtIDNo.Text = xIdNo

       rs.Close
     End If
   
    Exit Sub
    
err:

    MsgBox err.Description, vbCritical, "Error"

Set rs = Nothing
End Sub

[AndreRet]

I have tested your code. The problem lies with your database connection

Call con

. Once I have added a direct connection, all worked well, the empId updated its numbers, sooooo, check your call to the database connection "cn" on line 255

Dim dbX As ADODB.Connection
Set dbX = New ADODB.Connection
dbX.CursorLocation = adUseClient
dbX.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0; Data Source=" & App.Path & "\Employee.mdb"

    Dim rsX As ADODB.Recordset
    Set rsX = New ADODB.Recordset
    'If rsX.State = adStateOpen Then rsX.Close
 
    rsX.Open "Select * from EmpRecord", dbX, adOpenStatic, adLockOptimistic
    If rsX.BOF = True Or rsX.EOF = True Then
 
       'No records
       txtIDNo.Text = "10000"
 
       rsX.Close
       Exit Sub
          Else
       rsX.MoveLast
 
Dim xIdNo As Integer
 
       xIdNo = rsX!IdNo
       xIdNo = xIdNo + 1
       txtIDNo.Text = xIdNo
 
       rsX.Close
     End If
End Sub

[AndreRet]

I have also noticed that you use a lot of duplication code. Try the following to clear textboxes etc -

PrivateSub ClearTextBoxes(frm As Form)

Dim Control As Control

 For Each Control In frm.Controls
        If TypeOf Control Is TextBox Then
            Control.Text = vbNullstring 'We do not use ""
        End If
       
    Next Control
End Sub

n'Now call the function where ever
Call ClearTextBoxes Me

[abelingaw]

Wow, i didnt know about a code like this haha, im such a beginner.

Regarding this part sir

#
If TypeOf Control Is TextBox Then
#
Control.Text = vbNullstring 'We do not use ""
#
End If

the exception is my txtIDNo (for employee ID) A null value cannot be allowed

of course with the code you also helped me with..

Public Sub InitData()

Dim dbX As ADODB.Connection
Set dbX = New ADODB.Connection
dbX.CursorLocation = adUseClient
dbX.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0; Data Source=" & App.Path & "\Database.mdb"

    Dim rsX As ADODB.Recordset
    Set rsX = New ADODB.Recordset
    'If rsX.State = adStateOpen Then rsX.Close
 
    rsX.Open "Select * from EmpRecord", dbX, adOpenStatic, adLockOptimistic
    If rsX.BOF = True Or rsX.EOF = True Then
 
       'No records
       txtIDNo.Text = "10000"
 
       rsX.Close
       Exit Sub
          Else
       rsX.MoveLast
 
Dim xIdNo As Integer
 
       xEmpID = rsX!EmpID
       xEmpID = xEmpID + 1
       txtIDNo.Text = xEmpID
 
       rsX.Close
     End If
End Sub

How can i use the code without clearing the txtIDNo.?

[AndreRet]

Add the following -

PrivateSub ClearTextBoxes(frm As Form)
 
Dim Control As Control
 
 For Each Control In frm.Controls
        If TypeOf Control Is TextBox And Not TextBox.Name = "txtIdNo" Then
            Control.Text = vbNullstring 'We do not use ""
        End If
 
    Next Control
End Sub

This will clear all textboxes except the specified one.

If all of this worked for you, do not forget to mark the thread as solved please.

Happy coding.