CODEWITHSUNDEEP
ms-accessvb6
miles
miles

Reputation: 225

Operation is not allowed when the object is open

Im getting that error when I try to code my vb6 Log in method. I check all the recordset and I cant see any open recordset. Why am I getting this error? The logic of this Log in program is that as the user enters a username and password in the textfield, I check if it is correct based on the database(ms access) value, and terminate the program if he entered invalid username and password 3x. When I tried my program it's working on correct username and password but if I try to make 3x error input it gives me that error just in 2nd try of invalid input.

Can someone help me?

Here's my code:

Dim Con As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim Rs2 As New ADODB.Recordset
Dim ctr As Integer
Dim cmdCommand As New ADODB.Command
Dim have As Integer
Dim Username As String
Dim Password As String

Private Sub cmdLogin_Click()
  If ctr <> 3 Then
    If txtUsername.Text = Username And txtPassword.Text = Password Then
      MsgBox "Login Successful!!"
      MDIForm1.Show
      Unload Me
    ElseIf txtUsername.Text <> Username And txtPassword.Text <> Password Then
      MsgBox "Invalid Log in!"
      txtUsername.Text = ""
      txtPassword.Text = ""
      txtUsername.SetFocus
    ElseIf txtUsername.Text <> Username And txtPassword.Text = Password Then
      MsgBox "Invalid Log in!"
      txtUsername.Text = ""
      txtPassword.Text = ""
      txtUsername.SetFocus
    ElseIf txtUsername.Text = Username And txtPassword.Text <> Password Then
      MsgBox "Invalid Log in!"
      txtUsername.Text = ""
      txtPassword.Text = ""
      txtUsername.SetFocus
    ElseIf txtUsername.Text = "" And txtPassword.Text = "" Then
      MsgBox "Invalid Log in!"
      txtUsername.Text = ""
      txtPassword.Text = ""
      txtUsername.SetFocus
    Else
      txtUsername.Text = ""
      txtPassword.Text = ""
      txtUsername.SetFocus
    End If
    ctr = ctr + 1
  Else
    MsgBox "You are not a valid user! The Program will be terminated"
    End
  End If
End Sub

Private Sub Form_Load()
  Call OpenConnection

  With Rs
    .ActiveConnection = Con
    .CursorType = adOpenDynamic
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
  End With
End Sub

Private Sub OpenConnection()
  If Con.State = 1 Then
    Con.Close
  End If
  Set Con = New ADODB.Connection
  Con.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;DataSource=C:\Users\User\Documents\dbMMM.accdb;Persist Security Info=False;"
  Con.Open
End Sub

Private Sub txtUsername_LostFocus()
  With Rs2
    .ActiveConnection = Con
    .Source = "Select * From tblUser where UserName = '" & txtUsername.Text & "' "       'The highlight of my error is in this line
    .CursorType = adOpenDynamic
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
    .Open
    have = 0
    If Rs2.EOF = False Then
      Rs2.MoveFirst
      Do
        Username = Rs2.Fields(0)
        Password = Rs2.Fields(1)
        Rs2.MoveNext
      Loop Until Rs2.EOF = True
      Rs2.Close
    End If
  End With
End Sub

Upvotes: 0

Views: 6124

Answers (1)

Deanna
Deanna

Reputation: 24253

Your _LostFocus code leaves the recordset open if there are no matches for the user name. (This is a lot clearer now the code has been indented properly)

I much better way to handle this is to do a single check when the login button is pressed to see if any record matches BOTH the username and password, rather then finding a user, then manually comparing passwords.

With Rs2
  .ActiveConnection = Con
  .Source = "Select * From tblUser where UserName = '" & Replace(txtUsername.Text, "'", "''") & "' AND Password = '" & Replace(txtPassword.Text, "'", "''") & "';"
  .CursorType = adOpenDynamic
  .CursorLocation = adUseClient
  .LockType = adLockOptimistic
  .Open
  LoginValid = Not .EOF
  .Close
End With

Upvotes: 1

Related Questions