• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1149
  • Last Modified:

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.
0
sxxgupta
Asked:
sxxgupta
  • 8
  • 3
1 Solution
 
BlackIce80Commented:
i think this link might help you, also you have to adapt it a littlebit to get the login you'd like:

http://www.tek-tips.com/faqs.cfm?fid=1021.
0
 
sxxguptaAuthor Commented:
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.

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

Open in new window

0
 
BlackIce80Commented:
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.
 
0
NFR key for Veeam Backup for Microsoft Office 365

Veeam is happy to provide a free NFR license (for 1 year, up to 10 users). This license allows for the non‑production use of Veeam Backup for Microsoft Office 365 in your home lab without any feature limitations.

 
sxxguptaAuthor Commented:
sorry my vba knowledge is that of a beginner.  where or how do i open the commandshell.
Sanj
0
 
sxxguptaAuthor Commented:
never mind figured out what command shell meant.  sorry will keep u posted
0
 
sxxguptaAuthor Commented:
I am getting a runtime error 13 type mismatch on the following line:
 Set prp = dbs.CreateProperty(strPropName, varPropType, varPropValue)
0
 
BlackIce80Commented:
what version of access are you using?
0
 
sxxguptaAuthor Commented:
2000.
0
 
sxxguptaAuthor Commented:
Anythoughts BlackIce?
0
 
sxxguptaAuthor Commented:
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.
0
 
msacc97Commented:
Hi sxxgupta,

My suggestion is to create hidden form which will be opened at a startup and run its code in a background.
Set its Timer Interval property to something other than 0. Say 300. This value is in milliseconds so do not make it too small to prevent processor overload by your database.

Place the snippet below into hidden form's code.
This will call Input Box to enter password when any form opened in design mode.
Find sample database attached.

Another option you might consider is using user level security, available in Access 2000 (not available in Access 2007 and 2010)

Generally speaking, Access does not provide effective security protection and my code (as well as any other solutions) can be bypassed by advanced user.

The only way to prevent user from editing forms at all, is to compile your database as mde file.


Option Compare Database
Option Explicit

Dim strDesignAllowedForm As String

Public Sub subCheckDesignPass(strPassword As String)
    Dim strForm As String, db As DAO.Database
    Dim doc As DAO.Document

    Set db = CurrentDb

    For Each doc In db.Containers("Forms").Documents
        strForm = doc.Name

        If SysCmd(acSysCmdGetObjectState, acForm, strForm) <> 0 Then
            If Forms(strForm).CurrentView = 0 And strForm <> strDesignAllowedForm Then
                    Forms(strForm).Visible = False
                    If InputBox("Enter Password") <> strPassword Then
                        DoCmd.Close acForm, strForm, acSaveYes
                    Else
                        Forms(strForm).Visible = True
                        strDesignAllowedForm = strForm
                    End If
            End If
        End If

    Next doc

    Set doc = Nothing
    db.Close
    Set db = Nothing
End Sub

Private Sub Form_Timer()
'set Forms' Timer Interval to value > 0
    Call subCheckDesignPass("pass") ' place password here
End Sub

Open in new window

DisableDesignView2k.mdb
0
 
sxxguptaAuthor Commented:
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.
0

Featured Post

Upgrade your Question Security!

Add Premium security features to your question to ensure its privacy or anonymity. Learn more about your ability to control Question Security today.

  • 8
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now