Hello All
I'm trying to add an auto-login function to a database, that will recognise users already logged in to the network through a VBA script that will:
1 - Recognise the user details trying to gain access to the db (using the environ variable)
2 - Validate their details against the table of registered users
3 - If they are listed, allow them access, If not exit the app with an approprate message.
I have got so far with this but cannot get the script to work properly.
Can anybody help me please?
For clarity:
TblStaff is the table containing staff data
Within the table:
Staff_Number is the field being searched to validate the entry
Current is a ticked-box field confirming that the staff member is working on the correct team
Private Sub ValInTbl_Click()
On Error GoTo Error_Handler
Dim sSQL As String
Dim sTable As String
Dim sField As String
Dim sValue As String
Dim ValInTbl As Boolean
Set db = CurrentDb()
sTable = TblStaff
sField = TblStaff.Staff_Number.Value
sValue = Environ$("USERNAME")
Select Case db.TableDefs(sTable).Fields(sField).Value
Case dbByte, dbInteger, dbLong, dbSingle, dbDouble, dbBoolean
sSQL = "SELECT [" & sField & "] FROM [" & sTable & "] WHERE [" & sField & "]=" & sValue
Case dbText, dbMemo
sSQL = "SELECT [" & sField & "] FROM [" & sTable & "] WHERE [" & sField & "]='" & sValue & "'"
Case dbDate
sSQL = "SELECT [" & sField & "] FROM [" & sTable & "] WHERE [" & sField & "]=#" & sValue & "#"
End Select
Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot)
MsgBox (ValInTbl), vbCritical
If rs.RecordCount <> 0 Then
ValInTbl = True
MsgBox "Welcome to Our Database", (ValInTbl) & vbCrLf & _
vbCritical
Else
ValInTbl = False
MsgBox "You are not an authorised user. The application will now close", (ValInTbl) & vbCrLf & _
vbCritical
DoCmd.Quit
End If
Error_Handler_Exit:
On Error Resume Next
rs.Close
Set rs = Nothing
Set db = Nothing
Exit Sub
Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: ValInTbl" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Sub
Bookmarks