Click here to Skip to main content
15,897,371 members
Please Sign up or sign in to vote.
0.00/5 (No votes)
See more:
I always get this error everytime I ran the program.
VB
Dim rs As New ADODB.Recordset
rs.Open "Select * From tbluser Where uname = '" & txtuser.Text & "'", cnn, adOpenStatic, adLockReadOnly
If rs.RecordCount < 1 Then
MsgBox "Invalid Username!", vbCritical, "Login Error"
txtuser.SetFocus
Exit Sub
Else
If txtpass.Text = rs!pword Then
Unload Me
Load Form2
Form2.Show
Exit Sub
Else
MsgBox "Invalid Password!", vbCritical, "Login Error"
txtpass.SetFocus
Exit Sub
End If
End If
Set rs = Nothing

MODULE CODE:
VB
Option Explicit

Public cnn As ADODB.Connection
Public Sub getconnected()
  Set cnn = New ADODB.Connection
  cnn.CursorLocation = adUseClient
  cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Database1.mdb" & ";Persist Security Info=False;"
  
  cnn.Open
    End Sub


THE HIGHLIGHTED CODE:
VB
rs.Open "Select * From tbluser Where uname = '" & txtuser.Text & "'", cnn, adOpenStatic, adLockReadOnly

I just added Module1.getconnected on top of Dim rs As New ADODB.Recordset and it's working but based on the original program that I copied there's no Module1.getconnected
Posted
Updated 7-Mar-13 9:37am
v3

1 solution

If you want to check that user exists or not and you use Button1_Click() event, try this:
VB
Private Sub Button1_Click(...)
Dim cnn As ADODB.Connection
Dim rs As New ADODB.Recordset

On Error Goto Err_Handler

'connect to database
Set cnn = New ADODB.Connection()
cnn.CursorLocation = adUseClient
cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Database1.mdb" & ";Persist Security Info=False;"
cnn.Open
'create new recordset object
Set rs = New ADODB.Recordset()
rs.Open "Select * From tbluser Where uname = '" & txtuser.Text & "'", cnn, adOpenStatic, adLockReadOnly
If rs.RecordCount <> 1 Then
    Msgbox "Users count: " & rs.RecordCount, vbQuestion, "How is this possible?"
    Goto Exit_Sub
End If

'only one user!!!
'do what you want to do ;)
MsgBox "Welcome!" & vbCr & "Herzlich Willkomen!" &  vbCr & "Witaj!", vbInformation, "Message..."

Exit_Sub:
    On Error Resume Next
    rs.Close
    cnn.Close
    Set rs = Nothing
    set cnn = Nothing
    Exit Sub

Err_Handler:
    Msgbox Err.Description, vbExclamation, "Error " & Err.Number
    Resume Exit_Sub
End Sub
 
Share this answer
 

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)



CodeProject, 20 Bay Street, 11th Floor Toronto, Ontario, Canada M5J 2N8 +1 (416) 849-8900