Helpful Information
 
 
Category: Other Databases
Help working through 'No Current Record' error in Access

In Access 2000, I am trying to create a login form where the user logs in and depending on what rights they have, another form opens. There are two tables I am using (tblGroup and tblUser)...the SQL statement uses an inner join between the tables and searches for the UserName in the User table and the Description in the Group table. If the UserName exists in the user table and the description in the Group table is 'Admin' then frmAddRecord opens...if the UserName exists in the user table and the description is 'User' in the group table, then frmSearch is opened. I want an error to be thrown if txtUserName is left blank or if the name entered is not in tblUser. With the code I have, I am receiving a 'Run-time error '3021': No Current Record.' error on this line - strUserName = rs!UserName. Does anyone know what I need to do in order for this to work properly? Any help would be greatly appreciated. Here's my code for the command button that the user hits after they enter their username:



Private Sub cmdLogin_Click()
Dim db As Database
'Dim rs As Recordset
'Dim rs As Recordset
Dim rs As Recordset

'Dim strCriteria As String
Dim strSQL As String
Dim strUserName As String
Dim strDescription As String
Dim stDocName As String
Dim stDocName2 As String

'Set rst = CurrentDb.OpenRecordset("tblUsers", dbOpenDynaset)
'Me!txtUserName = UCase(Me!txtUserName)
'criteria = "[UserName] = '" & Me!txtUserName & "'"
Set db = CurrentDb

strSQL = "Select tblGroup.Description, tblUser.UserName From tblGroup, tblUser Where tblGroup.GroupID = tblUser.GroupID and UserName = '" & txtUserName.Value & "'"

'MsgBox strSQL
'Debug.Print strSQL

Set rs = db.OpenRecordset(strSQL)

strUserName = rs!UserName
strDescription = rs!Description
stDocName = "frmAddRequest"
stDocName2 = "frmSearch"


If UCase(txtUserName.Value) = strUserName And strDescription = "Admin" Then 'Check if user is Admin
DoCmd.OpenForm stDocName, acNormal
ElseIf UCase(txtUserName.Value) = strUserName And strDescription = "User" Then 'Check if user is User
DoCmd.OpenForm stDocName2, acNormal
ElseIf IsNull(Me.txtUserName) Then 'Not a Valid User
MsgBox "Please enter a user name!"
Me!txtUserName.SetFocus
Else
MsgBox "The user name you entered is not valid!"
Me!txtUserName.SetFocus
End If

db.Close
Set db = Nothing
Set rs = Nothing

End Sub


Thanks,
Shannon

hi i have the same promblem when i run data through this software it comes up with No current Record Error 3021. can any one help me with this.

Regards
Matt

Before doing anything with the recordset, you should verify if it is empty. If is not empty then check user status; else, do nothing or add new user.

Private Sub cmdLogin_Click()
Dim db As Database
'Dim rs As Recordset
'Dim rs As Recordset
Dim rs As Recordset

'Dim strCriteria As String
Dim strSQL As String
Dim strUserName As String
Dim strDescription As String
Dim stDocName As String
Dim stDocName2 As String

'Set rst = CurrentDb.OpenRecordset("tblUsers", dbOpenDynaset)
'Me!txtUserName = UCase(Me!txtUserName)
'criteria = "[UserName] = '" & Me!txtUserName & "'"
Set db = CurrentDb

strSQL = "Select tblGroup.Description, tblUser.UserName From tblGroup, tblUser Where tblGroup.GroupID = tblUser.GroupID and UserName = '" & txtUserName.Value & "'"

'MsgBox strSQL
'Debug.Print strSQL

Set rs = db.OpenRecordset(strSQL)

If Not ((rs.BOF = True) and (rs.EOF = True)) then

strUserName = rs!UserName
strDescription = rs!Description
stDocName = "frmAddRequest"
stDocName2 = "frmSearch"


If UCase(txtUserName.Value) = strUserName And strDescription = "Admin" Then 'Check if user is Admin
DoCmd.OpenForm stDocName, acNormal
ElseIf UCase(txtUserName.Value) = strUserName And strDescription = "User" Then 'Check if user is User
DoCmd.OpenForm stDocName2, acNormal
ElseIf IsNull(Me.txtUserName) Then 'Not a Valid User
MsgBox "Please enter a user name!"
Me!txtUserName.SetFocus
Else
MsgBox "The user name you entered is not valid!"
Me!txtUserName.SetFocus
End If

Else
'Exit Sub 'Do Nothing or
rs.AddNew
'Enter field info for each required field
rs.Fields("UserName").Value = TheUserName
rs.Update
End If
db.Close
Set db = Nothing
Set rs = Nothing

End Sub

You can also try trap the error.

Private Sub cmdLogin_Click()
On Error GoTo HandleMyError
Dim db As Database
'Dim rs As Recordset
'Dim rs As Recordset
Dim rs As Recordset

'Dim strCriteria As String
Dim strSQL As String
Dim strUserName As String
Dim strDescription As String
Dim stDocName As String
Dim stDocName2 As String

'Set rst = CurrentDb.OpenRecordset("tblUsers", dbOpenDynaset)
'Me!txtUserName = UCase(Me!txtUserName)
'criteria = "[UserName] = '" & Me!txtUserName & "'"
Set db = CurrentDb

strSQL = "Select tblGroup.Description, tblUser.UserName From tblGroup, tblUser Where tblGroup.GroupID = tblUser.GroupID and UserName = '" & txtUserName.Value & "'"

'MsgBox strSQL
'Debug.Print strSQL

Set rs = db.OpenRecordset(strSQL)

strUserName = rs!UserName
strDescription = rs!Description
stDocName = "frmAddRequest"
stDocName2 = "frmSearch"


If UCase(txtUserName.Value) = strUserName And strDescription = "Admin" Then 'Check if user is Admin
DoCmd.OpenForm stDocName, acNormal
ElseIf UCase(txtUserName.Value) = strUserName And strDescription = "User" Then 'Check if user is User
DoCmd.OpenForm stDocName2, acNormal
ElseIf IsNull(Me.txtUserName) Then 'Not a Valid User
MsgBox "Please enter a user name!"
Me!txtUserName.SetFocus
Else
MsgBox "The user name you entered is not valid!"
Me!txtUserName.SetFocus
End If

db.Close
Set db = Nothing
Set rs = Nothing

Exit Sub

HandleMyError:
If Err.Number = 3021 then
rs.AddNew
'Enter field info for each required field
rs.Fields("UserName").Value = TheUserName
rs.Update
Resume
ElseIf Err.Number = 3022 Then
MsgBox "The requested change can not be done because this" & Chr(10) & _
"would create duplecate recorsin the database. Verify" & Chr(13) & _
"the information and try again.", vbExclamation + vbOKOnly, "Duplicate"
rs.CancelUpdate
Exit Sub 'Could be Resume or Resume Next
Else
MsgBox "The error is " & Err.Number & " that means " & Chr(13) & _
Err.Description & ".", vbInformation + vbOKOnly, "Error"
Exit Sub 'Could be Resume or Resume Next
End if
End Sub
Hope if helps!
:)










privacy (GDPR)