T
Tangz
I have an access database that is intended to be shared by multiple
users. I would like to have a login page that sets database privileges
based on login, i.e admin gets full privileges and other users get
limited functionality. I don't have any problems in the code that sets
the privileges but what i noticed is that the database properties
don't get refreshed after setting the privileges. For example the
StartupShowDBWindow is disabled for all users except admin, however i
can't get the DB window to show once the property is set to true but
if i go to Tools>Startup, the property is set to true. Similarly i
can't get the other startup options to reset once the permissions are
set. I would like to know to refresh the settings once the privileges
are set.
Here is my current login form code:
// Login command button code //
Private Sub Enter_Click()
If IsNull(Trim(txtUser)) Then
MsgBox "Please enter User Name", vbExclamation
txtUser.SetFocus
Exit Sub
End If
If IsNull(Trim(txtPassword)) Then
MsgBox "Password required", vbExclamation
txtPassword.SetFocus
Exit Sub
End If
Dim tempRecordSet As Recordset, Password As String
Dim Permission As Variant
'Dim intLogonAttempts As Integer
Set tempRecordSet = CurrentDb.OpenRecordset("select * from
tblUsrDetails where UCase(trim(Name)) = '" & UCase(Trim(txtUser)) &
"'")
If tempRecordSet.RecordCount <> 0 Then
Password = UCase(Trim(tempRecordSet("Password")))
End If
tempRecordSet.Close
Set tempRecordSet = Nothing
Permission = DLookup("[Level]", "tblUsrDetails", "[Name] = Forms!
frmMain!txtUser")
SetPermission (Permission) ' Calls the permission function that
sets privileges
If Password = UCase(Trim(txtPassword)) Then
DoCmd.OpenForm "frmSearch", acNormal
DoCmd.Close acForm, "frmMain"
Else
MsgBox "Incorrect Password", vbExclamation
End If
intLogonAttempts = intLogonAttempts + 1
If intLogonAttempts >= 2 Then
MsgBox "You do not have access to this database.Please contact
admin.", _
vbCritical, "Restricted Access!"
Application.Quit
End If
End Sub
Function SetPermission(level As String)
If level <> "A" Then
Call SetDBProperty_PP("StartupMenuBar", dbBoolean, True)
Call SetDBProperty_PP("StartupShowDBWindow", dbBoolean, True)
Call SetDBProperty_PP("StartupShowStatusBar", dbBoolean, True)
Call SetDBProperty_PP("AllowBuiltinToolbars", dbBoolean, True)
Call SetDBProperty_PP("AllowShortcutMenus", dbBoolean, True)
Call SetDBProperty_PP("AllowToolbarChanges", dbBoolean, True)
Call SetDBProperty_PP("AllowFullMenus", dbBoolean, True)
Call SetDBProperty_PP("AllowBreakIntoCode", dbBoolean, True)
'Call SetDBProperty_PP("AllowSpecialKeys", dbBoolean, True)
'Call SetDBProperty_PP("AllowBypassKey", dbBoolean, True)
End If
End Function
// Function that changes the startup properties //
Public Function SetDBProperty_PP(ByRef paPrpName As String, ByRef
paPrpType As Integer, ByRef paPrpValue As Variant)
Dim lvDB As Database
Dim lvPrp As Property
On Error GoTo Err_laSetDBProperty_PP
Set lvDB = CurrentDb
Set lvPrp = lvDB.CreateProperty(paPrpName, paPrpType, paPrpValue)
lvDB.Properties.Append lvPrp
Exit_laSetDBProperty_PP:
Exit Function
Err_laSetDBProperty_PP:
If Err.Number = mcErrPrpAlreadyExists Then
lvDB.Properties(paPrpName) = paPrpValue
Else
MsgBox "Error " & Err.Number & vbCrLf & Err.Description,
vbCritical
End If
Resume Exit_laSetDBProperty_PP
End Function
Any help will be appreciated
Thanks
Thangam
users. I would like to have a login page that sets database privileges
based on login, i.e admin gets full privileges and other users get
limited functionality. I don't have any problems in the code that sets
the privileges but what i noticed is that the database properties
don't get refreshed after setting the privileges. For example the
StartupShowDBWindow is disabled for all users except admin, however i
can't get the DB window to show once the property is set to true but
if i go to Tools>Startup, the property is set to true. Similarly i
can't get the other startup options to reset once the permissions are
set. I would like to know to refresh the settings once the privileges
are set.
Here is my current login form code:
// Login command button code //
Private Sub Enter_Click()
If IsNull(Trim(txtUser)) Then
MsgBox "Please enter User Name", vbExclamation
txtUser.SetFocus
Exit Sub
End If
If IsNull(Trim(txtPassword)) Then
MsgBox "Password required", vbExclamation
txtPassword.SetFocus
Exit Sub
End If
Dim tempRecordSet As Recordset, Password As String
Dim Permission As Variant
'Dim intLogonAttempts As Integer
Set tempRecordSet = CurrentDb.OpenRecordset("select * from
tblUsrDetails where UCase(trim(Name)) = '" & UCase(Trim(txtUser)) &
"'")
If tempRecordSet.RecordCount <> 0 Then
Password = UCase(Trim(tempRecordSet("Password")))
End If
tempRecordSet.Close
Set tempRecordSet = Nothing
Permission = DLookup("[Level]", "tblUsrDetails", "[Name] = Forms!
frmMain!txtUser")
SetPermission (Permission) ' Calls the permission function that
sets privileges
If Password = UCase(Trim(txtPassword)) Then
DoCmd.OpenForm "frmSearch", acNormal
DoCmd.Close acForm, "frmMain"
Else
MsgBox "Incorrect Password", vbExclamation
End If
intLogonAttempts = intLogonAttempts + 1
If intLogonAttempts >= 2 Then
MsgBox "You do not have access to this database.Please contact
admin.", _
vbCritical, "Restricted Access!"
Application.Quit
End If
End Sub
Function SetPermission(level As String)
If level <> "A" Then
Call SetDBProperty_PP("StartupMenuBar", dbBoolean, True)
Call SetDBProperty_PP("StartupShowDBWindow", dbBoolean, True)
Call SetDBProperty_PP("StartupShowStatusBar", dbBoolean, True)
Call SetDBProperty_PP("AllowBuiltinToolbars", dbBoolean, True)
Call SetDBProperty_PP("AllowShortcutMenus", dbBoolean, True)
Call SetDBProperty_PP("AllowToolbarChanges", dbBoolean, True)
Call SetDBProperty_PP("AllowFullMenus", dbBoolean, True)
Call SetDBProperty_PP("AllowBreakIntoCode", dbBoolean, True)
'Call SetDBProperty_PP("AllowSpecialKeys", dbBoolean, True)
'Call SetDBProperty_PP("AllowBypassKey", dbBoolean, True)
End If
End Function
// Function that changes the startup properties //
Public Function SetDBProperty_PP(ByRef paPrpName As String, ByRef
paPrpType As Integer, ByRef paPrpValue As Variant)
Dim lvDB As Database
Dim lvPrp As Property
On Error GoTo Err_laSetDBProperty_PP
Set lvDB = CurrentDb
Set lvPrp = lvDB.CreateProperty(paPrpName, paPrpType, paPrpValue)
lvDB.Properties.Append lvPrp
Exit_laSetDBProperty_PP:
Exit Function
Err_laSetDBProperty_PP:
If Err.Number = mcErrPrpAlreadyExists Then
lvDB.Properties(paPrpName) = paPrpValue
Else
MsgBox "Error " & Err.Number & vbCrLf & Err.Description,
vbCritical
End If
Resume Exit_laSetDBProperty_PP
End Function
Any help will be appreciated
Thanks
Thangam