Sanjay
asked on
VBA code to prompt user to enter a password when the user wants to access a form or report in DESIGN view
Could someone kindly help me with coming up with VBA code that prompts a user to enter a valid password in a message box (with an OK and Cancel button) when the user wants to access a form or report in DESIGN view. If the password is incorrect, the user is prompted with a message box (with OK and Cancel button) stating "Incorrect Password, Try Again" and loop back through the code until a valid password is entered. Or the user has the option to click on the Cancel button to exit out of the message box and stop the VBA code. If the password is correct, the user can access the form or report in design view.
ASKER
I put in the code as shown in
http://www.tek-tips.com/faqs.cfm?pid=181&fid=1172
and now my db is all locked up and I cannot see it. Luckily I made a backup. Can someone help me tweak this code. Thanks.
http://www.tek-tips.com/faqs.cfm?pid=181&fid=1172
and now my db is all locked up and I cannot see it. Luckily I made a backup. Can someone help me tweak this code. Thanks.
Option Compare Database
Option Explicit
Global sLogon As String
Public Function StartUp()
Dim Designer As String
Dim Restart As Boolean
Dim stAppName As String
Designer = "yourlogonhere"
FIND_USER
If sLogon = Designer Then
Restart = UnlockStartup
Else
Restart = LockStartup
End If
If Restart Then
'Close database and re-open
stAppName = "MSAccess.exe " & CurrentDb.Name
Call Shell(stAppName, 1)
DoCmd.Quit
Else
If sLogon <> Designer Then DoCmd.OpenForm "TitleForm"
End If
End Function
-----------------------------------
Sub FIND_USER()
On Error GoTo ERR_FIND_USER
Dim UserParam$
Dim sChk As String
Dim CurrentAuditor As String
UserParam$ = Environ("S_USER")
If UserParam$ = "" Then UserParam$ = Environ("USERNAME")
sLogon = UCase$(UserParam$)
EXIT_FIND_USER:
Exit Sub
ERR_FIND_USER:
MsgBox Error$
Resume EXIT_FIND_USER
End Sub
---------------------------------------------
Function LockStartup() As Boolean
Dim Restart As Boolean
Restart = False
ChangeProperty "StartupShowDBWindow", dbBoolean, False, Restart
ChangeProperty "AllowBuiltinToolbars", dbBoolean, False, Restart
ChangeProperty "AllowFullMenus", dbBoolean, False, Restart
ChangeProperty "AllowToolbarChanges", dbBoolean, False, Restart
ChangeProperty "AllowBreakIntoCode", dbBoolean, False, Restart
ChangeProperty "AllowSpecialKeys", dbBoolean, False, Restart
ChangeProperty "AllowBypassKey", dbBoolean, False, Restart
Application.SetOption "Show Hidden Objects", False
LockStartup = Restart
End Function
-----------------------------------------------
Function UnlockStartup() As Boolean
Dim Restart As Boolean
Restart = False
ChangeProperty "StartupMenuBar", dbText, "(default)", Restart
ChangeProperty "StartupShowDBWindow", dbBoolean, True, Restart
ChangeProperty "StartupShowStatusBar", dbBoolean, True, Restart
ChangeProperty "AllowBuiltinToolbars", dbBoolean, True, Restart
ChangeProperty "AllowFullMenus", dbBoolean, True, Restart
ChangeProperty "AllowToolbarChanges", dbBoolean, True, Restart
ChangeProperty "AllowBreakIntoCode", dbBoolean, True, Restart
ChangeProperty "AllowSpecialKeys", dbBoolean, True, Restart
ChangeProperty "AllowBypassKey", dbBoolean, True, Restart
UnlockStartup = Restart
End Function
-------------------------------------------
Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant, Restart As Boolean) As Integer
Dim dbs As Database, prp As Property
Dim CurrentPropVal As Variant
Const conPropNotFoundError = 3270
Set dbs = CurrentDb
On Error GoTo Change_Err
CurrentPropVal = dbs.Properties(strPropName)
If CurrentPropVal <> varPropValue Then
dbs.Properties(strPropName) = varPropValue
Restart = True 'need to restart database
End If
ChangeProperty = True
Change_Bye:
Exit Function
Change_Err:
If Err = conPropNotFoundError Then 'Property not found.
Set prp = dbs.CreateProperty(strPropName, varPropType, varPropValue)
dbs.Properties.Append prp
Resume Next
Else
' Unknown error.
ChangeProperty = False
Resume Change_Bye
End If
End Function
you have to replace youlogonhere in line 10 with the user you want to access all the features. all other users will be locked out.
you can find your username in the environment variables (open commandshell and type: set)
if you want a loginscreen you have to design a form and check the entered values instead of line 11.
you can find your username in the environment variables (open commandshell and type: set)
if you want a loginscreen you have to design a form and check the entered values instead of line 11.
ASKER
sorry my vba knowledge is that of a beginner. where or how do i open the commandshell.
Sanj
Sanj
ASKER
never mind figured out what command shell meant. sorry will keep u posted
ASKER
I am getting a runtime error 13 type mismatch on the following line:
Set prp = dbs.CreateProperty(strProp Name, varPropType, varPropValue)
Set prp = dbs.CreateProperty(strProp
what version of access are you using?
ASKER
2000.
ASKER
Anythoughts BlackIce?
ASKER
I got the above code to work. The toolbars get disabled etc. However, with the switchboard, a user can still access a form that I have given the user. The form opens up in form view. The problem is that all the user has to do is right-click on the form and access the form in Design view. All I am asking is to programatically prevent the user from accessing the design view of a report or form without entering a password in a message box. I really don't care about the toolbars nor do I want to create a front-end database to do this. Is there a way to programatically accomplish this task? The above code really does not prevent this. Thanks.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Agreed. An mde file is the way to go. But I just needed a simple solution without having to split the database. Thank you very much.
http://www.tek-tips.com/faqs.cfm?fid=1021.