If you are using a network where users login under a unique ID, you can capture that ID in MS Access.  This FAQ provides the code necessary to capture the ID, validate users that open the database, and disable the shift key for bypassing the autoexec macro.

There are many uses for the login ID.  The following are a few:
-Provide custom feedback for the user
-Keep unwanted users out of your application
-Apply security (works well, but not as comprehensive or specific as Access' security)
-Stamp new and changed records by writing the ID to a table
-Whatever your heart desires

GET THE LOGIN ID:

Paste the following code in a module:

---------------------------------------

Declare Function wu_GetUserName Lib "advapi32.dll" Alias _
   "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) _
   As Long

Function ap_GetUserName() As Variant

   Dim strUserName As String
   Dim lngLength As Long
   Dim lngResult As Long

   '-- Set up the buffer
   strUserName = String$(255, 0)
   lngLength = 255

   '-- Make the call
   lngResult = wu_GetUserName(strUserName, lngLength)

   '-- Assign the value
   ap_GetUserName = Left(strUserName, InStr(1, strUserName, Chr(0)) - 1)

End Function

---------------------------------------

To get the Login ID, just assign it to a variable:
    strUserName = ap_GetUserName
or use it in a sql string:
    ... Where fldUserName = """ & ap_GetUserName & """;"

EXAMPLE
One good example of using the Login ID is to keep users out of a database using this ID.  Create a table with the valid user id's and check the list using an AutoExec macro with the RunCode command.
You will need to:
- Disable the shift key by running the ap_DisableShift function in the debug window (see following Code)
- Check the Login ID in a function (see following Code for ValidateUser) and kick the user out if it does not match.

---------------------------------------

Public Function ValidateUser()

'Confirm that the user should be able to enter this database
    Dim db As DAO.Database, rst As DAO.Recordset

    Set db = CurrentDb
    Set rst = db.OpenRecordset("SELECT fldUser FROM tblValidUsers WHERE fldUser = """ & UCase(ap_GetUserName) & """;")

    'Check to see if the user name is in the list of valid users
    If rst.EOF Then
        MsgBox "You are not authorized to use this database!" & vbNewLine & _
            "Please contact the ************* Department for permission.", _
            vbCritical, "No Authorization"
        rst.Close
        Set rst = Nothing
        Set db = Nothing
        Application.Quit
    End If

    rst.Close
    Set rst = Nothing
    Set db = Nothing

End Function

---------------------------------------
SHIFT BYPASS: (AND ENABLE)
---------------------------------------

Function ap_DisableShift()
'This function will disable the shift at startup causing
'the Autoexec macro and Startup properties to always be executed

    On Error GoTo errDisableShift

    Dim db As DAO.Database
    Dim prop As Property
    Const conPropNotFound = 3270

    Set db = CurrentDb()

    'This next line disables the shift key on startup.
    db.Properties("AllowByPassKey") = False

'function successful
Exit Function

errDisableShift:
    'The first part of this error routine creates the "AllowByPassKey
    'property if it does not exist.
    If Err = conPropNotFound Then
    Set prop = db.CreateProperty("AllowByPassKey", _
        dbBoolean, False)
        db.Properties.Append prop
        Resume Next
    Else
        MsgBox "Function 'ap_DisableShift' did not complete successfully."
        Exit Function
    End If

End Function

Function ap_EnableShift()
'This function will enable the shift key at startup causing
'the Autoexec macro and Startup properties to be bypassed
'if the user holds down the shift key when opening the database.

    On Error GoTo errEnableShift

    Dim db As Database
    Dim prop As Property
    Const conPropNotFound = 3270

    Set db = CurrentDb()

    'This next line disables the shift key on startup.
    db.Properties("AllowByPassKey") = True

'function successful
Exit Function

errEnableShift:
    'The first part of this error routine creates the "AllowByPassKey
    'property if it does not exist.
    If Err = conPropNotFound Then
    Set prop = db.CreateProperty("AllowByPassKey", _
        dbBoolean, True)
        db.Properties.Append prop
        Resume Next
    Else
        MsgBox "Function 'ap_DisableShift' did not complete successfully."
        Exit Function
    End If

End Function

----------------------------------

To run the disable shift, paste the above two functions in a module, then, open the debug window.  Type: ap_DisableShift and press <return>.  You will not be able to use the shift key to get around the startup procedures (including the autoexec macro) until the ap_EnableShift is run on the application.

Back to Microsoft: Access Other topics FAQ Index
Back to Microsoft: Access Other topics Forum

My Archive

My FAQ Archive

Come Join Us!

Posting Guidelines

Jobs

Microsoft: Access Other topics FAQ

Security

My Archive

Join Tek-Tips® Today!

Join Tek-Tips^® Today!