Run-time error 2471 access vba - vba

Please, HELP
I have a login form where Combo box contains 3 fields (EmployeeID, Employee Name: [FirstName] & " " & [LastName], JobTitle - qry picked). In dropdown list is only one field shown (properties set 0', 1', 0' width). Also frmLogin contains a text box to enter a password and there are two hidden text boxes (Name and JobTitle for other functions to perform). When I choose the UserName, hidden boxes are populated; however, when I enter password, the popup window shows up with Run-time error ‘2471’ - The expression you entered as a query parameter produced the following error: ‘admin’.
Here is a code to log in.
Private Sub cmdLogin_Click()
If IsNull(Me.cboLoginName) Or Me.cboLoginName = "" Then
MsgBox "You must select an employee name.", vbOKOnly, "Required data"
Me.cboLoginName.SetFocus
Exit Sub
End If
If IsNull(Me.tbxPassword) Or Me.tbxPassword = "" Then
MsgBox "You must enter a password", vbOKOnly, "Required data"
Me.tbxPassword.SetFocus
Exit Sub
End If
'next line is highlighted as error
If Me.tbxPassword.Value = DLookup("Password", "tblEmployees", "[EmployeeID]=" & Me.cboLoginName.Value) Then
Me.Visible = False
DoCmd.OpenForm "frmEntry"
Else
MsgBox "Invalid employee name / password combination. Please try again.", vbOKOnly, "Invalid Entry!"
Me.tbxPassword.SetFocus
End If
End Sub
Query for the combobox

Since I don't know the rowsource of your combobox or the number of columns your control specifies, paste the following code before your DLookup and see which column you should be using:
Dim i As Integer
For i = 0 To Me.cboLoginName.ColumnCount
Debug.Print "Column " & i & " contains '" & Me.cboLoginName.Column(i) & "'"
Next i

Related

VBA code works in one Access Database, but not another. All of the supporting objects have been imported. What I am not seeing?

This code is for a login form I have setup to enter the front end copy of a database. In one database it works like a charm. I imported the form and corresponding objects to another database and it appears to be not recognizing my password when I enter it. I just keep getting the message box I have popping up that says, "Incorrect password". Any help figuring this out would be greatly apprecaited.
The SQL statement that drives the cboUser combo box on the login form is:
SELECT tblUser.UserID, [FName] & " " & [LName] AS Fullname,
tblUser.Password, tblUser.PWReset, tblUser.AccessLevelID
FROM tblUser ORDER BY tblUser.LName, tblUser.FName;
.
Private Sub OkBTN_Click()
Static intIncorrectCount As Integer
Dim AuthorityNumber As Integer
'Dim rs As Recordset
'TempVars("Username") = Me.cboUser.Value
'Column references for cbouser row source reference
'UserID = 0
'FullName = 1
'Password = 2
'PWReset = 3
'AccessLevelID = 4
'Set rs = CurrentDb.OpenRecordset("UserNameQuery", dbOpenSnapshot)
'N = Nz(DLookup("Fullname", "UserNameQuery", "Fullname=""" & Me.cboUser & """"), " ")
'Check that User is selected
If IsNull(Me.cboUser) Then
MsgBox "You forgot To Select your name from the drop down menu!", vbCritical
Me.cboUser.SetFocus
Else
'Check for correct password
If Me.txtPassword = Me.cboUser.Column(2) Then
'Check if password needs to be reset
If Me.cboUser.Column(3) Then
DoCmd.OpenForm "frmPasswordChange", , , "[UserID] = " & Me.cboUser
End If
Me.Visible = FALSE
intIncorrectCount = 0
'Main menu after correct login based on AuthorityNumber
If Me.cboUser.Column(4) = 5 Then
DoCmd.OpenForm "SRL1MainMenu"
'Forms!AMSReportForm!L2Menubtn.Visible = False
Forms!SRL1MainMenu!FullNameLoggedIn = Forms!frmLogin!cboUser.Column(1)
Else
DoCmd.OpenForm "L2MainMenu2"
'Forms!AMSReportForm!L2Menubtn.Visible = True
Forms!L2MainMenu2!FullNameLoggedIn = Forms!frmLogin!cboUser.Column(1)
End If
'Failed login attempt limitation
ElseIf intIncorrectCount > 1 Then
MsgBox "Too many failed login attempts. Click OK To Set New password", vbOK + vbExclamation
DoCmd.OpenForm "frmPasswordChange", , , "[UserID] = " & Me.cboUser
'DoCmd.Close acForm, "frmLogin"
Else
MsgBox "Incorrect password", vbOKOnly + vbExclamation
Me.txtPassword = Null
Me.txtPassword.SetFocus
intIncorrectCount = intIncorrectCount + 1
End If
End If
End Sub
First, #Andre is probably right - you may have to apply brackets to "Password".
Next, this may not perform a case sensitive comparison:
If Me.txtPassword = Me.cboUser.Column(2) Then
Use StrComp to do that:
If StrComp(Me!txtPassword.Value, Me!cboUser.Column(2), vbBinaryCompare) = 0 Then
Finally, you should never store plain passwords; store a hash value instead. It isn't that difficult, if you study my latest article:
Storing passwords in VBA using the Microsoft NG Cryptography (CNG) API

Validating a textbox entry if duplicate display error message microsoft access

i have searched around and cant find an answer, so i am using Microsoft Access Office 2019 and cant seem to validate my textbox for a duplicate entry. The user will add a record and enter a short text primary key (which in this case is the new employee's ID) Field - [EMPID] in the [EMPDETAILS] table. The below code has worked for validating my Autonumber primary key but doesnt seem to work for a custom short text primary key and i am getting this error
"The expression you entered as a query parameter produced this error :
'VS123'
<= this is the Employee ID which is a custom short text primary key :
Private Sub unqidd_BeforeUpdate(Cancel As Integer)
On Error GoTo Err_Handler
Dim strMessage As String
'PartNum is the name of a textbox that contains the primary key, the rest are text to display.
strMessage = "Employee ID" & Me!unqidd & " already exists."
' confirm that part number doesn't already exist.
If (DLookup("[empid]", "[empdetails]", "[empID] = " & Forms![driverdetails]![unqidd])) Then
MsgBox strMessage, vbInformation, "Invalid Operation"
Cancel = True
End If
Exit_Here:
Exit Sub
Err_Handler:
MsgBox Err.Description
Resume Exit_Here
End Sub
Since you are trying to add a string into [empID] I am going to assume it is a string field, in which case you need to include quotes:
If (DLookup("[empid]", "[empdetails]", "[empID] = '" & Forms![driverdetails]![unqidd] & "'")) Then
The solution is as below :
1) Create an unbound textbox (Text1616) and set its control source as
=DLookUp("[empid]","[empdetails]","[empID] = '" & [Forms]![Driverdetails]![unqidd] & "'")
2) The textbox (Unqidd) that will need to be validated, on its beforeupdate property set the event procedure code as below :
Private Sub unqidd_BeforeUpdate(Cancel As Integer)
On Error GoTo Err_Handler
Dim strMessage As String
'PartNum is the name of a textbox that contains the primary key, the rest are text to
display.
strMessage = "Employee ID" & Me!unqidd & " already exists."
' confirm that part number doesn't already exist.
If Me.unqidd.Value = Me.Text1616 Then
MsgBox strMessage, vbInformation, "Invalid Operation"
Cancel = True
End If
Exit_Here:
Exit Sub
Err_Handler:
MsgBox Err.Description
Resume Exit_Here
End Sub
'References :
'Table Name : empdetails
'Table primary key : empid (Short text)
'Form Name : Driverdetails
'Textbox 1 : unqidd (no formats, control source : empid)
'Textbox 2 : Text1616 (Unbound Textbox)

How to refill combobox with similar records based on what user types

I'm currently building a form where a user can look up a tool based on the description or part number.
I want user to be able to type any letters into the combobox that I have tied to a query listing all my tools and the combobox will repopulate itself with the tools most similar to what is present in their combobox. For example, if they start typing wre, then tools that have similar characters will start appearing in the combobox such as wrench, torque wrench, power wrench, etc.
I've tried looking around for other people's solutions to this but either I didn't fully comprehend the existing solution (I'm fairly new to Access) or it wasn't what I was looking for. I've seen that people suggested using a listbox instead but I really don't want to go down that route.
I was thinking about using what the user types in the combobox and my VBA code will pick up the "change event" and requery the combobox on the fly by using their input as the like criteria for the new query.
Is this a possible route? Will it be slower? Is there a better route?
I'm hoping someone can show some examples on how to achieve what I'm looking for.
The search as you type feature is very useful! With a textbox and a listbox, you can setup a dynamic search tool that will filter a list for approximate matches as you type. The textbox has four events associated with it, as seen here.
The code behind the form looks like this. Pay attention to the part in bold. This is where we create a string of SQL commands, and utilize the SQL Like operator, to get dynamic matches as we type. Pay attention to the text in bold below.
Option Compare Database
Option Explicit On
Private blnSpace As Boolean 'INCLUDE THIS LINE ON YOUR FORM
Private Sub btnClearFilter_Click()
'CODE FOR THE RED "X" BUTTON TO CLEAR THE FILTER AND SHOW ALL
On Error Resume Next
Me.txtSearch.Value = ""
txtSearch_Change()
End Sub
Private Sub txtSearch_Change()
'CODE THAT HANDLES WHAT HAPPENS WHEN THE USER TYPES IN THE SEARCH BOX
Dim strFullList As String
Dim strFilteredList As String
If blnSpace = False Then
Me.Refresh 'refresh to make sure the text box changes are actually available to use
'specify the default/full rowsource for the control
strFullList = "SELECT RecordID, First, Last FROM tblNames ORDER BY First;"
'specify the way you want the rowsource to be filtered based on the user's entry
strFilteredList = "SELECT RecordID, First, Last FROM tblNames WHERE [First] LIKE ""*" & Me.txtSearch.Value &
"*"" OR [Last] LIKE ""*" & Me.txtSearch.Value & "*"" ORDER BY [First]"
'run the search
fLiveSearch Me.txtSearch, Me.lstItems, strFullList, strFilteredList, Me.txtCount
End If
End Sub
Private Sub txtSearch_KeyPress(KeyAscii As Integer)
'NECESSARY TO IDENTIFY IF THE USER IS HITTING THE SPACEBAR
'IN WHICH CASE WE WANT TO IGNORE THE INPUT
On Error GoTo err_handle
If KeyAscii = 32 Then
blnSpace = True
Else
blnSpace = False
End If
Exit Sub
err_handle:
Select Case Err.Number
Case Else
MsgBox "An unexpected error has occurred: " & vbCrLf & Err.Description &
vbCrLf & "Error " & Err.Number & "(" & Erl() & ")"
End Select
End Sub
Private Sub txtSearch_GotFocus()
' USED TO REMOVE THE PROMPT IF THE CONTROL GETS FOCUS
On Error Resume Next
If Me.txtSearch.Value = "(type to search)" Then
Me.txtSearch.Value = ""
End If
End Sub
Private Sub txtSearch_LostFocus()
' USED TO ADD THE PROMPT BACK IN IF THE CONTROL LOSES FOCUS
On Error Resume Next
If Me.txtSearch.Value = "" Then
Me.txtSearch.Value = "(type to search)"
End If
End Sub
Finally, in a regular module, you will need this script.
Option Compare Database
Option Explicit On
'************* Code Start **************
' This code was originally written by OpenGate Software
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
' OpenGate Software http://www.opengatesw.net
Function fLiveSearch(ctlSearchBox As TextBox, ctlFilter As Control,
strFullSQL As String, strFilteredSQL As String, Optional ctlCountLabel As Control)
Const iSensitivity = 1 'Set to the number of characters the user must enter before the search starts
Const blnEmptyOnNoMatch = True 'Set to true if you want nothing to appear if nothing matches their search
On Error GoTo err_handle
'restore the cursor to where they left off
ctlSearchBox.SetFocus
ctlSearchBox.SelStart = Len(ctlSearchBox.Value) + 1
If ctlSearchBox.Value <> "" Then
'Only fire if they've input more than two characters (otherwise it's wasteful)
If Len(ctlSearchBox.Value) > iSensitivity Then
ctlFilter.RowSource = strFilteredSQL
If ctlFilter.ListCount > 0 Then
ctlSearchBox.SetFocus
ctlSearchBox.SelStart = Len(ctlSearchBox.Value) + 1
Else
If blnEmptyOnNoMatch = True Then
ctlFilter.RowSource = ""
Else
ctlFilter.RowSource = strFullSQL
End If
End If
Else
ctlFilter.RowSource = strFullSQL
End If
Else
ctlFilter.RowSource = strFullSQL
End If
'if there is a count label, then update it
If IsMissing(ctlCountLabel) = False Then
ctlCountLabel.Caption = "Displaying " & Format(ctlFilter.ListCount - 1, "#,##0") & " records"
End If
Exit Function
err_handle:
Select Case Err.Number
Case 91 'no ctlCountLabel
'exit
Case 94 'null string
'exit
Case Else
MsgBox "An unexpected error has occurred: " & vbCrLf & Err.Description &
vbCrLf & "Error " & Err.Number & vbCrLf & "Line: " & Erl()
End Select
End Function
The code comes from this link:
http://www.opengatesw.net/ms-access-tutorials/Access-Articles/Search-As-You-Type-Access.html

Combo box getting "Enter Parameter Value" prompt when clicking a button

Any ideas why I am getting an "Enter Parameter Value" input box when running this code?
Private Sub cmdPrint_Click()
Dim str As String
On Error GoTo ErrHandler
If IsNull(Me.Combo_1) Then
MsgBox "Can't print an unsaved record", _
vbOKOnly, "Error"
Exit Sub
End If
str = "Combo_1 = '" & Me!Combo_1 & "'"
Debug.Print str
DoCmd.OpenReport "rptBarCodeLabels(2)", acViewPreview, , str
Exit Sub
ErrHandler:
MsgBox Err.Number & ": " _
& Err.Description, vbOKOnly, "Error"
End Sub
Edit: The button is being used to print a label of what's currently selected in Combo_1. Once the print button has been clicked, I wanted it to display the single record I chose in the label report I have it referencing. I am using Access 2003 if that means anything.
If a field name in a query contains punctuation (Combo_1), you should enclose in brackets, like so:
str = "[Combo_1] = '" & Me!Combo_1 & "'"
The Report is expecting a parameter, but not getting it because it's not being passed through in the correct manner.
I've found a solution by using some coding that was provided here: http://www.techrepublic.com/article/how-to-print-one-or-more-labels-for-a-single-access-record/
What fixed the error was most likely creating a temporary table and temporary report.

VB compile error when trying to use String.Compare

I am trying to check if the password is the same or not (in terms of caps too) using vb.net. But the line
result = String.Compare(actPassword,userPassword)
keep giving error "Compile Error: Expected:("
Private Sub Login_Click()
'Check to see if data is entered into the UserName combo box
If IsNull(Me.cmbLoginID) Or Me.cmbLoginID = "" Then
MsgBox "You must enter a User Name.", vbOKOnly, "Required Data"
Me.cmbLoginID.SetFocus
Exit Sub
End If
'Check to see if data is entered into the password box
If IsNull(Me.txtPW) Or Me.txtPW = "" Then
MsgBox "You must enter a Password.", vbOKOnly, "Required Data"
Me.txtPW.SetFocus
Exit Sub
End If
'Check value of password in tblEmployees to see if this matches value chosen in combo box
Dim userPassword As String
Dim actPassword As String
Dim result As Integer
userPassword = txtPW.Text
actPassword = DLookup("EmpPassword", "Employee", "EmployeeID='" + Me.cmbLoginID.Value + "'")
result = String.Compare(actPassword,userPassword)
If result = -1 Then
'Close logon form and open splash screen
DoCmd.Close acForm, "Login", acSaveNo
DoCmd.OpenForm "HomePage"
Else
MsgBox "Password Invalid. Please Try Again", vbCritical + vbOKOnly, "Invalid Entry!"
Me.txtPW.SetFocus
End If
'If User Enters incorrect password 3 times database will shutdown
intLogonAttempts = intLogonAttempts + 1
If intLogonAttempts > 3 Then
MsgBox "You do not have access to this database. Please contact your system administrator.", vbCritical, "Restricted Access!"
Application.Quit
End If
End Sub
That's because there is no String.Compare() in VBA (There is in VB.NET)
Also, please note VB.NET is not VBA
Use StrComp
Use StrComp
result = StrComp(actPassword, userPassword, vbTextCompare)
While String.Compare() exists in VB.Net, I don't think it does in VBA. In any case, what you're doing is wrong anyway.
String.Compare can return any integer and it will only return zero if they match. Your particular test (comparing against -1) is only checking one possibility, that the actual password is less than the desired one, and it's only checking for one of the possible negative values.
You would be better off in that case with something like:
if result <> 0 Then
However, if you just want to compare two strings for equality in VBA (rather than figure out the relative ordering), you can just use:
if actPassword = userPassword Then