Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Disable Design view through VB coding

Access Howto:

Disable Design view through VB coding

by  Maquis  Posted    (Edited  )
Hi there. Here are a few functions which I have found to be extremely helpful and I thought maybe someone else would like them as well.

First a disclaimer. I am using Access 97 and this code works in Access 97. Some of this code, especially the object variable declarations will need to be tweaked in order to work in Access 2000 and beyond.

What this code basically does is hide the database design from your users, however if you as the designer open the database it will open directly to the database window. I've found that it's generally a pain to mess with shifting into the database or hunting for transparent buttons whenever I've wanted to modify some code for a user.

I make no claims as to the efficiency of the code. I'm sure some of the VB gurus here could vastly improve upon the code. (You know who you are, feel free to e-mail improvements)

Code: 
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

To get it working just follow these steps:
1. Put the above code in a module in your db.
2. Create a macro called autoexec and put RunCode StartUp() in it.
3. In the StartUp function change the "Designer = " line to your logon id, or change the designer variable to an array of names which can access the database design.
4. In the StartUp function change the docmd.openform command to reference your start up form.
Register to add this FAQ to your archive
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top