Link to home
Start Free TrialLog in
Avatar of wenyonk
wenyonk

asked on

How To Disable Menus and Toolbars in forms on the fly.

Can anyone help me figure out this code what it is doing and how I can use it in my application.  I would like to be able to turn on and off menu items and toolbars from within forms.  Please help.  Please comment each line to earn the points!


Public Sub SetStartupProperties()
  Const DB_Text As Long = 10
  Const DB_Boolean As Long = 1
  Dim strCmdLine As String
  Dim retval As Variant

  'strCmdLine = "GetMeIn"
  'MsgBox Command()

  strCmdLine = Command()

  'If strCmdLine = "GetMeIn" Then
     'ChangeProperty "StartupForm", DB_Text, "Customers"
     ChangeProperty "StartupShowDBWindow", DB_Boolean, True
     'ChangeProperty "StartupShowStatusBar", DB_Boolean, True
     'ChangeProperty "AllowBuiltinToolbars", DB_Boolean, True
     'ChangeProperty "AllowFullMenus", DB_Boolean, True
     'ChangeProperty "AllowBreakIntoCode", DB_Boolean, True
     'ChangeProperty "AllowSpecialKeys", DB_Boolean, True
     ChangeProperty "AllowBypassKey", DB_Boolean, True
  'Else
     'ChangeProperty "StartupForm", DB_Text, "Customers"
     'ChangeProperty "StartupShowDBWindow", DB_Boolean, False
     'ChangeProperty "StartupShowStatusBar", DB_Boolean, False
     'ChangeProperty "AllowBuiltinToolbars", DB_Boolean, False
     'ChangeProperty "AllowFullMenus", DB_Boolean, False
     'ChangeProperty "AllowBreakIntoCode", DB_Boolean, False
     'ChangeProperty "AllowSpecialKeys", DB_Boolean, False
     'ChangeProperty "AllowBypassKey", DB_Boolean, False
  'End If

End Sub

Public Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
   Dim dbs As Object, prp As Variant
   Const conPropNotFoundError = 3270

   Set dbs = CurrentDb
   On Error GoTo Change_Err
   dbs.Properties(strPropName) = varPropValue
   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
Avatar of 1William
1William

This function is designed to set a db up, to prevent unautorized access to it.  Each of the items in the first procedure are startup properies, like toobars, app name, allw special keys and so on.  You can turn them on and off.

Public Sub SetStartupProperties()
 Const DB_Text As Long = 10
 Const DB_Boolean As Long = 1
 Dim strCmdLine As String
 Dim retval As Variant

 'strCmdLine = "GetMeIn"
 'MsgBox Command()

 strCmdLine = Command()

 'If strCmdLine = "GetMeIn" Then
    'ChangeProperty "StartupForm", DB_Text, "Customers"
    ChangeProperty "StartupShowDBWindow", DB_Boolean, True
    'ChangeProperty "StartupShowStatusBar", DB_Boolean, True
    'ChangeProperty "AllowBuiltinToolbars", DB_Boolean, True
    'ChangeProperty "AllowFullMenus", DB_Boolean, True
    'ChangeProperty "AllowBreakIntoCode", DB_Boolean, True
    'ChangeProperty "AllowSpecialKeys", DB_Boolean, True
    ChangeProperty "AllowBypassKey", DB_Boolean, True
 'Else
    'ChangeProperty "StartupForm", DB_Text, "Customers"
    'ChangeProperty "StartupShowDBWindow", DB_Boolean, False
    'ChangeProperty "StartupShowStatusBar", DB_Boolean, False
    'ChangeProperty "AllowBuiltinToolbars", DB_Boolean, False
    'ChangeProperty "AllowFullMenus", DB_Boolean, False
    'ChangeProperty "AllowBreakIntoCode", DB_Boolean, False
    'ChangeProperty "AllowSpecialKeys", DB_Boolean, False
    'ChangeProperty "AllowBypassKey", DB_Boolean, False
 'End If

End Sub



This section is called by the first to implement them.

Public Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
  Dim dbs As Object, prp As Variant
  Const conPropNotFoundError = 3270

  Set dbs = CurrentDb
  On Error GoTo Change_Err
  dbs.Properties(strPropName) = varPropValue
  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
Avatar of wenyonk

ASKER

I don't understand the getmein  where is that used, how is it used.

I usually call this on form startup and pass to it a command line variable from a shortcut.  This reset the values to enable ME to get tothe db windoe, see full menus and all.

you will want to call this from the button on the form.  You probably will want this section to be like this:

Public Sub SetStartupProperties(byval boShowNoShow as boolean)
Const DB_Text As Long = 10
Const DB_Boolean As Long = 1



if boShowNoShow  ' You send it a true value from your button
   'ChangeProperty "AllowBuiltinToolbars", DB_Boolean, True   ' You will now have this
   'ChangeProperty "AllowFullMenus", DB_Boolean, True           ' You will now have this
'Else      ' You sent it a false from your command button
   'ChangeProperty "AllowBuiltinToolbars", DB_Boolean, False   ' You will not have this
   'ChangeProperty "AllowFullMenus", DB_Boolean, False           ' You will not have this

'End If

End Sub

In a shortcut, you can pass in a value using the cmd\ switch.  Here is a special shortcut:
"C:\Program Files\Microsoft Office\Office\MSACCESS.EXE" "C:\BypassShiftKey\BypassShiftKey.mdb" /cmd "GetMeIn"
Avatar of wenyonk

ASKER

I have a form called SplashScreen which loads at startup.  I would like to use the code sample in this thread to disable toolbars and menus.

What would I put where?
Ok, in the form load event, put this:
SetStartupProperties(False)
I se a typo.........

This line:
if boShowNoShow  ' You send it a true value from your button

Should be this (left out the then):
if boShowNoShow then   ' You send it a true value from your button
And un-comment those out too.
Here, forgive me.

Public Sub SetStartupProperties(byval boShowNoShow as boolean)
Const DB_Text As Long = 10
Const DB_Boolean As Long = 1

if boShowNoShow  then       ' You send it a true value from your button
  ChangeProperty "AllowBuiltinToolbars", DB_Boolean, True   ' You will now have this
  ChangeProperty "AllowFullMenus", DB_Boolean, True           ' You will now have this
Else      ' You sent it a false from your command button
  ChangeProperty "AllowBuiltinToolbars", DB_Boolean, False   ' You will not have this
  ChangeProperty "AllowFullMenus", DB_Boolean, False           ' You will not have this
End If

End Sub


One more point (I mentioned this in the other Q)  Make backups.  Make Backups.  I cannot stress this enough.  A mistake can be fatal will messing with some of these properties.
If you would like, I'll email you a example zipped for A2000.  Just give me your email address.  
SOLUTION
Avatar of heer2351
heer2351

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Ah, I see where you are driving.  Depends on the security model.  I use a special shortcut, with its own password instead of Access security, in fact I have my own security syste created that is a lot less of a headache than Access's.  Nice to know though, it can be toggled via Access.
Let me guess your security system uses MDE files and the username as retrieved from the operating system.
Well I do use a MDE, and I do retrietrive the computer name and login ID.  The reason for the MDE is mostly what the managers want, as the security I have pretty much makes the point of MDE/MDB moot, although a MDE is a little easier to move great distances (A 50 mb mdb shrinks to about 35 when it is a mde).  I retrieve the user name and computer ID to make the login name appear in the login screen for a user when I also resolve the computer name. I also use this info when determining who is in at a given time via the ldb.  Additionally, I get the current PC email address.
However... the real security does not use any of this.  It is all code and lock down via code.  No tables linked without a valid login.  No db window access (as this question just nicks upon) and a host of other things.
William,

Thanks for the info I sometimes use something along the same lines but without using a MDE it seems tough to protect the source code.
I know.  The only reason I do not worry about the source code is the companies that I work for, very high security and they own the app (me as a contractor).  Mostly, the security is used to keep the honest honest, prevent '''Accidental''' unapproved access,  The really important stuff (data) is encrypted.  As you know, a thief, well, they can always get in.  I just make it require an absolute, criminal act to do so, and I can track attempts.  Then the company prosecutes.
As far as the source code, in the company, other developers are welcome to it (LOL, they are the only ones who could crack it if they wanted).  Th companies own it, not I (even though I was one of the developers on the team), although I do keep example copies.

I am not surprised you do things in a similar method, esp. when a Access security cracker is what, $25? To get a developer to crack mine would cost several thousand, minumum.  and anyways, Access security is a pain (at least in my opinion).  I would like to see a more intelligent/user friendly interface to it.

Have a great weekend. :)
Avatar of wenyonk

ASKER


Following and below is the solution.  Thank You 1William for all you help and direction.

STEPS:
-------------------------------------------------------------------------------------------------------------
0  -  **** Make a BACKUP of the current database you would like to put this in.   ****

1  -  Paste the CODE following "module" in a module.

2  -  Create a macro called Autoexec and selected "RunCode" placed the AutoExec()  function in the textbox associated with the RunCode command.

3  -  Created an Administrative shortcut (This shortcut is hidden somewhere on the system) with the following target:  
"C:\Program Files\Microsoft Office\Office10\MSACCESS.EXE" "C:\CompanyName\ClaimsTrac.mdb" /cmd "GetMeIn"

4  -  Created an User shortcut with the following target:
"C:\Program Files\Microsoft Office\Office10\MSACCESS.EXE" "C:\CompanyName\ClaimsTrac.mdb"

5  -  Created another macro called ExitToAccess and selected "RunCode" placed the SetAdminToolbarsAndMenus ()  function in the textbox associated with the RunCode command (This still does not work that way I would like).

6  -  Added item 5 to the switchboard.

7  -  Used Access security to restrict the use of the ExitToAccess  macro.

8  -  Test


NOTE:
-------------------------------------------------------------------------------------------------------------
As I mentioned in item 5 (This still does not work that way I would like), the problem is
when I logon using the User shortcut and the menus and toolbars are disabled, I use
the ExitToAccess switchboard item the menus and toolbars are not displayed or enabled.
Also several of the properties commented out are invalid.  Should anyone find the correct
property names and/or come up with a "Fix" for Item 5, I will be happy to post a new
question and award them points.


CODE:
-------------------------------------------------------------------------------------------------------------
I placed this code in a "module".

Public Function Autoexec()

    On Error GoTo Autoexec_Error
   
    ' Declare local variables.
    Dim strCmdLine As String
    Dim bolRetVal As Boolean

    'strCmdLine = "GetMeIn"
    ' Here for debugging only.
    'MsgBox Command()

    ' Initialize local variables.
    ' The Command function will return the argument portion of
    ' the command line used to launch Microsoft Access.
    strCmdLine = Command()

    ' Correct command line parameter is passed.
    If (strCmdLine = "GetMeIn") Then
       
        ' Call this function to set the menus and toolbars to the normal or admin mode use and returns the success
        ' or failure of doing so.  The true or false value may be discarded or used for further code execution.
        ' Normal mode use shows the access menus and toolbars, shows the DB startup window,
        ' allows breaks in code, special keys, and allows bypass key use.
        bolRetVal = SetAdminToolbarsAndMenus()
   
    ' In-correct or no command line parameter was passed.
    Else
   
        ' Call this function to set the menus and toolbars to the user mode use and returns the success
        ' or failure of doing so.  The true or false value mat be discarded or used for further code execution.
        ' User mode use removes the access menus and toolbars, does not show the DB startup window,
        ' does not allow breaks in code, special keys, or allow bypass key use.
        bolRetVal = SetUserToolbarsAndMenus()
    End If
   
Autoexec_Exit:
    Exit Function

Autoexec_Error:

    ' Decalre local variables
    Dim strError As String
   
    ' Create error message string to send to message box
    strError = "Error Number:           " & Err.Number & vbCrLf & "Error Description:      " & Err.Description & "     "
    ' Move the query or command that caused the error to the ActionPerformedCodeSection property.
    ActionPerformedCodeSection = Err.Source
    ' Call to set module information in global variables.
    'SetModuleInformation
    ' Move the procedure or function name that caused the error to the ActionPerformed property.
    ActionPerformed = "Autoexec() Function"
    ' Set the CA MessageBoxError property to true to use application and module
    ' information in the CA augmented messagebox during an error condition.
    MessageBoxError = True
    MsgBox strError, vbExclamation, "Autoexec() Error"
    Resume Autoexec_Exit
   
' End of the Autoexec function.
End Function

' This function is used to set the menus and toolbars to the normal or admin mode use and returns the success
' or failure of doing so.  The true or false value may be discarded or used for further code execution.
' Normal mode use shows the access menus and toolbars, shows the DB startup window,
' allows breaks in code, special keys, and allows bypass key use.
Public Function SetAdminToolbarsAndMenus() As Boolean

    On Error GoTo SetAdminToolbarsAndMenus_Error
   
    ' Decalre local variables.
    Dim bolRetVal As Boolean
   
    ' Set the default value to true for proper starting of the following IF statements.
    bolRetVal = True
   
    ' Call the ChangeDBProperty function to set the currentDB properties passed to the values
    ' passed (lets call it Normal or Admin mode).
    ' normal mode use shows the access menus and toolbars, shows the DB startup window,
    ' allows breaks in code, special keys, and allows bypass key use.
   
    ' Set the StartupForm property.
    If (bolRetVal = True) Then
        'bolRetVal = ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
    Else
        ' Report error "property not found" to user.
        Err.Raise 3270
    End If
   
    ' Set the StartupShowDBWindow property.
    If (bolRetVal = True) Then
        'bolRetVal = ChangeDBProperty("StartupShowDBWindow", DB_Boolean, True)
    Else
        ' Report error "property not found" to user.
        Err.Raise 3270
    End If
       
    ' Set the StartupShowStatusBar property.
    If (bolRetVal = True) Then
        'bolRetVal = ChangeDBProperty("StartupShowStatusBar", DB_Boolean, True)
    Else
        ' Report error "property not found" to user.
        Err.Raise 3270
    End If
   
    ' Set the AllowBuiltinToolbars property.
    If (bolRetVal = True) Then
        bolRetVal = ChangeDBProperty("AllowBuiltinToolbars", DB_Boolean, True)
    Else
        ' Report error "property not found" to user.
        Err.Raise 3270
    End If
       
    ' Set the AllowFullMenus property.
    If (bolRetVal = True) Then
        bolRetVal = ChangeDBProperty("AllowFullMenus", DB_Boolean, True)
    Else
        ' Report error "property not found" to user.
        Err.Raise 3270
    End If
   
    ' Set the AllowBreakIntoCode property.
    If (bolRetVal = True) Then
        'bolRetVal = ChangeDBProperty("AllowBreakIntoCode", DB_Boolean, True)
    Else
        ' Report error "property not found" to user.
        Err.Raise 3270
    End If
   
    ' Set the AllowSpecialKeys property.
    If (bolRetVal = True) Then
        bolRetVal = ChangeDBProperty("AllowSpecialKeys", DB_Boolean, True)
    Else
        ' Report error "property not found" to user.
        Err.Raise 3270
    End If
   
    ' Set the AllowBypassKey property.
    If (bolRetVal = True) Then
        'bolRetVal = ChangeDBProperty("AllowBypassKey", DB_Boolean, True)
    Else
        ' Report error "property not found" to user.
        Err.Raise 3270
    End If
   
    ' Return success in setting of specified property.
    SetAdminToolbarsAndMenus = bolRetVal

SetAdminToolbarsAndMenus_Exit:
    Exit Function

SetAdminToolbarsAndMenus_Error:

    ' Decalre local variables
    Dim strError As String
   
    ' Create error message string to send to message box
    strError = "Error Number:           " & Err.Number & vbCrLf & "Error Description:      " & Err.Description & "     "
    ' Move the query or command that caused the error to the ActionPerformedCodeSection property.
    ActionPerformedCodeSection = Err.Source
    ' Call to set module information in global variables.
    'SetModuleInformation
    ' Move the procedure or function name that caused the error to the ActionPerformed property.
    ActionPerformed = "SetAdminToolbarsAndMenus() Procedure"
    ' Set the CA MessageBoxError property to true to use application and module
    ' information in the CA augmented messagebox during an error condition.
    MessageBoxError = True
    MsgBox strError, vbExclamation, "SetAdminToolbarsAndMenus() Error"
   
    ' Return failure (error) in setting of specified property.
    SetAdminToolbarsAndMenus = bolRetVal
    Resume SetAdminToolbarsAndMenus_Exit
   
' End of the SetAdminToolbarsAndMenus procedure.
End Function

' This function is used to set the menus and toolbars to the user mode use and returns the success
' or failure of doing so.  The true or false value mat be discarded or used for further code execution.
' User mode use removes the access menus and toolbars, does not show the DB startup window,
' does not allow breaks in code, special keys, or allow bypass key use.
Public Function SetUserToolbarsAndMenus() As Boolean

    On Error GoTo SetUserToolbarsAndMenus_Error
   
    ' Decalre local variables.
    Dim bolRetVal As Boolean
   
    ' Set the default value to true for proper starting of the following IF statements.
    bolRetVal = True
   
    ' Call the ChangeDBProperty function to set the currentDB properties passed to the values
    ' passed (lets call it user mode).
    ' User mode use removes the access menus and toolbars, does not show the DB startup window,
    ' does not allow breaks in code, special keys, or allow bypass key use.
   
    ' Set the StartupForm property.
    If (bolRetVal = True) Then
        'bolRetVal = ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
    Else
        ' Report error "property not found" to user.
        Err.Raise 3270
    End If
   
    ' Set the StartupShowDBWindow property.
    If (bolRetVal = True) Then
        'bolRetVal = ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False)
    Else
        ' Report error "property not found" to user.
        Err.Raise 3270
    End If
       
    ' Set the StartupShowStatusBar property.
    If (bolRetVal = True) Then
        'bolRetVal = ChangeDBProperty("StartupShowStatusBar", DB_Boolean, False)
    Else
        ' Report error "property not found" to user.
        Err.Raise 3270
    End If
   
    ' Set the AllowBuiltinToolbars property.
    If (bolRetVal = True) Then
        bolRetVal = ChangeDBProperty("AllowBuiltinToolbars", DB_Boolean, False)
    Else
        ' Report error "property not found" to user.
        Err.Raise 3270
    End If
       
    ' Set the AllowFullMenus property.
    If (bolRetVal = True) Then
        bolRetVal = ChangeDBProperty("AllowFullMenus", DB_Boolean, False)
    Else
        ' Report error "property not found" to user.
        Err.Raise 3270
    End If
   
    ' Set the AllowBreakIntoCode property.
    If (bolRetVal = True) Then
        'bolRetVal = ChangeDBProperty("AllowBreakIntoCode", DB_Boolean, False)
    Else
        ' Report error "property not found" to user.
        Err.Raise 3270
    End If
   
    ' Set the AllowSpecialKeys property.
    If (bolRetVal = True) Then
        bolRetVal = ChangeDBProperty("AllowSpecialKeys", DB_Boolean, False)
    Else
        ' Report error "property not found" to user.
        Err.Raise 3270
    End If
   
    ' Set the AllowBypassKey property.
    If (bolRetVal = True) Then
        'bolRetVal = ChangeDBProperty("AllowBypassKey", DB_Boolean, False)
    Else
        ' Report error "property not found" to user.
        Err.Raise 3270
    End If
   
    ' Return success in setting of specified property.
    SetUserToolbarsAndMenus = bolRetVal

SetUserToolbarsAndMenus_Exit:
    Exit Function

SetUserToolbarsAndMenus_Error:

    ' Decalre local variables
    Dim strError As String
   
    ' Create error message string to send to message box
    strError = "Error Number:           " & Err.Number & vbCrLf & "Error Description:      " & Err.Description & "     "
    ' Move the query or command that caused the error to the ActionPerformedCodeSection property.
    ActionPerformedCodeSection = Err.Source
    ' Call to set module information in global variables.
    'SetModuleInformation
    ' Move the procedure or function name that caused the error to the ActionPerformed property.
    ActionPerformed = "SetUserToolbarsAndMenus() Procedure"
    ' Set the CA MessageBoxError property to true to use application and module
    ' information in the CA augmented messagebox during an error condition.
    MessageBoxError = True
    MsgBox strError, vbExclamation, "SetUserToolbarsAndMenus() Error"
   
    ' Return failure (error) in setting of specified property.
    SetUserToolbarsAndMenus = bolRetVal
    Resume SetUserToolbarsAndMenus_Exit
   
' End of the SetUserToolbarsAndMenus procedure.
End Function

' This property changes the current database properties passed to the values passed and returns the success
' or failure of doing so.  The true or false value mat be discarded or used for further code execution.
Public Function ChangeDBProperty(strPropertyName As String, varPropertyType As Variant, varPropertyValue As Variant) As Boolean

    On Error GoTo ChangeDBProperty_Error
   
    ' Decalre local variables.
    Dim objCurrentDB As Object

    ' initialze local variables.
    ' Sets the currentdb object to the current application db.
    Set objCurrentDB = Application.CurrentDb
 
    ' Sets the currentdb property passed to the value passed.
    objCurrentDB.Properties(strPropertyName) = varPropertyValue
   
    ' Return success in setting of specified property.
    ChangeDBProperty = True
   
ChangeDBProperty_Exit:
    Exit Function

ChangeDBProperty_Error:
   
    ' Decalre local variables
    Dim strError As String
   
    ' Create error message string to send to message box
    strError = "Error Number:           " & Err.Number & vbCrLf & "Error Description:      " & Err.Description & "     "
    ' Move the query or command that caused the error to the ActionPerformedCodeSection property.
    ActionPerformedCodeSection = Err.Source
    ' Call to set module information in global variables.
    'SetModuleInformation
    ' Move the procedure or function name that caused the error to the ActionPerformed property.
    ActionPerformed = "ChangeDBProperty() Function"
    ' Set the CA MessageBoxError property to true to use application and module
    ' information in the CA augmented messagebox during an error condition.
    MessageBoxError = True
    MsgBox strError, vbExclamation, "ChangeDBProperty() Error"
   
    ' Return failure (error) in setting of specified property.
    ChangeDBProperty = False
    Resume ChangeDBProperty_Exit
   
' End of the ChangeDBProperty function.
End Function
Avatar of wenyonk

ASKER

Heer2351:

I read your post and looked at the MVP link you provided.  Based on the code I presented above, what would you do.  I am using access security.  Need users to be able to changed these properties when they login and the same for when an admin logs in.

I am not sure I understand the Ddl portion, please explain...  Maybe I need to split these points?
Outstanding effort!  I In fact I think you went overboard a bit, but you write up is certainly commendable.  Instead of all the if's you could jst set a value to raise the error number on error.  Would run faster.

your desire to toggle stuff (change the set up values during runtime (in my experience to date, but then I have not put a lot of effot to make it happen the way you want, yet) is that the changes only take effect on restart.  What  I do instead is create cutom menus, tied to forms and call them innthe forms themselves.  I never allow fullmenus or toolbars, just my custom ones. After reading what you have done here, I know you understand how to do this.  The big advantae of this is as a developer, you can get in and have everything availble for you to work, then provide the users with only what they need (makes it simpler for them too) and keeps the users out of mischief.
I think Heer's comment is certainly worthy of a points split.

The link he provided, basically is stating that anyone who logs in using the special shortcut can reset the properties,  Add the extra boolean variant (DDL) means that if you are also using Access security, on a person with Admin rights to the could instigate the changes.  In the above scenario and using the DDL, it makes just that much more difficult for someone to break in.  The first few lines of the web page below say it all:

DDL Optional. A Variant (Boolean subtype) that indicates whether or not the Property is a DDL object. The default is False. If DDL is True, users can't change or delete this Property object unless they have dbSecWriteDef permission.

The CreateProperty method is used to create or set the AllowBypassKey property to true, which prevents a user from bypassing the startup properties and the AutoExec macro.  However, the sample code provided in the help files does not use the fourth DDL argument when making a call to CreateProperty. This means that anyone who can open the database can programmatically reset the AllowBypassKey value.
Avatar of wenyonk

ASKER

Below is a list of the Access 2002 Database property names (and Descriptions) as discussed in this thread.


Description                                  Property Name
----------------------------------------------------------------------------
Application Title                            AppTitle
Application Icon                            AppIcon
Display Form/Page                        StartupForm
Display Database Window             StartupShowDBWindow
Display Status Bar                         StartupShowStatusBar
Menu Bar                                       StartupMenuBar
Shortcut Menu Bar                         StartupShortcutMenuBar
Allow Full Menus                            AllowFullMenus
Allow Default Shortcut Menus        AllowShortcutMenus
Allow Built-In Toolbars                   AllowBuiltInToolbars
Allow Toolbar/Menu Changes        AllowToolbarChanges
Allow Viewing Code After Error      AllowBreakIntoCode
Use Access Special Keys                AllowSpecialKeys


Best Regards,

WenyonK
FL
Avatar of wenyonk

ASKER

1William:

In a previous response you said "...Instead of all the if's you could just set a value to raise the error number on error.  Would run faster."

What do you mean, can you provide a sample for clarification?


Well, you evaluate each property individually (for example, I look at just two of them)

   If (bolRetVal = True) Then
       'bolRetVal = ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
   Else
       ' Report error "property not found" to user.
       Err.Raise 3270
   End If
   
   ' Set the StartupShowDBWindow property.
   If (bolRetVal = True) Then
       'bolRetVal = ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False)
   Else
       ' Report error "property not found" to user.
       Err.Raise 3270
   End If

first, you check to see if a set boolean is true, you do that for all. If one of the properies does not evaluate to tru, the variable then is false for all the rest.
ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False)

If your concern that a a property does not exist or can error out, I would do this:

Public Function ChangeDBProperty(strPropertyName As String, varPropertyType As Variant, varPropertyValue As Variant) As Boolean ''True means successful'
on error goto Err_ChangeDBProperty

ChangeDBProperty = true

ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False) ' Or false, as the case may be

ChangeDBProperty_Exit:
   Exit Function

Err_ChangeDBProperty:
'ChangeDBProperty = true
    Select Case Err.Number  ' trap for the specified error number
        'Case
            'Resume next
        Case Else
            MsgBox Err.Number & " ~ " & Err.Description
    End Select
   
   Resume ChangeDBProperty_Exit

End Function


Well, you evaluate each property individually (for example, I look at just two of them)

   If (bolRetVal = True) Then
       'bolRetVal = ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
   Else
       ' Report error "property not found" to user.
       Err.Raise 3270
   End If
   
   ' Set the StartupShowDBWindow property.
   If (bolRetVal = True) Then
       'bolRetVal = ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False)
   Else
       ' Report error "property not found" to user.
       Err.Raise 3270
   End If

first, you check to see if a set boolean is true, you do that for all. If one of the properies does not evaluate to tru, the variable then is false for all the rest.
ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False)

If your concern that a a property does not exist or can error out, I would do this:

Public Function ChangeDBProperty(strPropertyName As String, varPropertyType As Variant, varPropertyValue As Variant) As Boolean ''True means successful'
on error goto Err_ChangeDBProperty

ChangeDBProperty = true

ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False) ' Or false, as the case may be

ChangeDBProperty_Exit:
   Exit Function

Err_ChangeDBProperty:
'ChangeDBProperty = true
    Select Case Err.Number  ' trap for the specified error number
        'Case
            'Resume next
        Case Else
            MsgBox Err.Number & " ~ " & Err.Description
    End Select
   
   Resume ChangeDBProperty_Exit

End Function


Well, you evaluate each property individually (for example, I look at just two of them)

   If (bolRetVal = True) Then
       'bolRetVal = ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
   Else
       ' Report error "property not found" to user.
       Err.Raise 3270
   End If
   
   ' Set the StartupShowDBWindow property.
   If (bolRetVal = True) Then
       'bolRetVal = ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False)
   Else
       ' Report error "property not found" to user.
       Err.Raise 3270
   End If

first, you check to see if a set boolean is true, you do that for all. If one of the properies does not evaluate to tru, the variable then is false for all the rest.
ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False)

If your concern that a a property does not exist or can error out, I would do this:

Public Function ChangeDBProperty(strPropertyName As String, varPropertyType As Variant, varPropertyValue As Variant) As Boolean ''True means successful'
on error goto Err_ChangeDBProperty

ChangeDBProperty = true

ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False) ' Or false, as the case may be

ChangeDBProperty_Exit:
   Exit Function

Err_ChangeDBProperty:
'ChangeDBProperty = true
    Select Case Err.Number  ' trap for the specified error number
        'Case
            'Resume next
        Case Else
            MsgBox Err.Number & " ~ " & Err.Description
    End Select
   
   Resume ChangeDBProperty_Exit

End Function


Well, you evaluate each property individually (for example, I look at just two of them)

   If (bolRetVal = True) Then
       'bolRetVal = ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
   Else
       ' Report error "property not found" to user.
       Err.Raise 3270
   End If
   
   ' Set the StartupShowDBWindow property.
   If (bolRetVal = True) Then
       'bolRetVal = ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False)
   Else
       ' Report error "property not found" to user.
       Err.Raise 3270
   End If

first, you check to see if a set boolean is true, you do that for all. If one of the properies does not evaluate to tru, the variable then is false for all the rest.
ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False)

If your concern that a a property does not exist or can error out, I would do this:

Public Function ChangeDBProperty(strPropertyName As String, varPropertyType As Variant, varPropertyValue As Variant) As Boolean ''True means successful'
on error goto Err_ChangeDBProperty

ChangeDBProperty = true

ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False) ' Or false, as the case may be

ChangeDBProperty_Exit:
   Exit Function

Err_ChangeDBProperty:
'ChangeDBProperty = true
    Select Case Err.Number  ' trap for the specified error number
        'Case
            'Resume next
        Case Else
            MsgBox Err.Number & " ~ " & Err.Description
    End Select
   
   Resume ChangeDBProperty_Exit

End Function


Well, you evaluate each property individually (for example, I look at just two of them)

   If (bolRetVal = True) Then
       'bolRetVal = ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
   Else
       ' Report error "property not found" to user.
       Err.Raise 3270
   End If
   
   ' Set the StartupShowDBWindow property.
   If (bolRetVal = True) Then
       'bolRetVal = ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False)
   Else
       ' Report error "property not found" to user.
       Err.Raise 3270
   End If

first, you check to see if a set boolean is true, you do that for all. If one of the properies does not evaluate to tru, the variable then is false for all the rest.
ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False)

If your concern that a a property does not exist or can error out, I would do this:

Public Function ChangeDBProperty(strPropertyName As String, varPropertyType As Variant, varPropertyValue As Variant) As Boolean ''True means successful'
on error goto Err_ChangeDBProperty

ChangeDBProperty = true

ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False) ' Or false, as the case may be

ChangeDBProperty_Exit:
   Exit Function

Err_ChangeDBProperty:
'ChangeDBProperty = true
    Select Case Err.Number  ' trap for the specified error number
        'Case
            'Resume next
        Case Else
            MsgBox Err.Number & " ~ " & Err.Description
    End Select
   
   Resume ChangeDBProperty_Exit

End Function


Well, you evaluate each property individually (for example, I look at just two of them)

   If (bolRetVal = True) Then
       'bolRetVal = ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
   Else
       ' Report error "property not found" to user.
       Err.Raise 3270
   End If
   
   ' Set the StartupShowDBWindow property.
   If (bolRetVal = True) Then
       'bolRetVal = ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False)
   Else
       ' Report error "property not found" to user.
       Err.Raise 3270
   End If

first, you check to see if a set boolean is true, you do that for all. If one of the properies does not evaluate to tru, the variable then is false for all the rest.
ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False)

If your concern that a a property does not exist or can error out, I would do this:

Public Function ChangeDBProperty(strPropertyName As String, varPropertyType As Variant, varPropertyValue As Variant) As Boolean ''True means successful'
on error goto Err_ChangeDBProperty

ChangeDBProperty = true

ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False) ' Or false, as the case may be

ChangeDBProperty_Exit:
   Exit Function

Err_ChangeDBProperty:
'ChangeDBProperty = true
    Select Case Err.Number  ' trap for the specified error number
        'Case
            'Resume next
        Case Else
            MsgBox Err.Number & " ~ " & Err.Description
    End Select
   
   Resume ChangeDBProperty_Exit

End Function


Well, you evaluate each property individually (for example, I look at just two of them)

   If (bolRetVal = True) Then
       'bolRetVal = ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
   Else
       ' Report error "property not found" to user.
       Err.Raise 3270
   End If
   
   ' Set the StartupShowDBWindow property.
   If (bolRetVal = True) Then
       'bolRetVal = ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False)
   Else
       ' Report error "property not found" to user.
       Err.Raise 3270
   End If

first, you check to see if a set boolean is true, you do that for all. If one of the properies does not evaluate to tru, the variable then is false for all the rest.
ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False)

If your concern that a a property does not exist or can error out, I would do this:

Public Function ChangeDBProperty(strPropertyName As String, varPropertyType As Variant, varPropertyValue As Variant) As Boolean ''True means successful'
on error goto Err_ChangeDBProperty

ChangeDBProperty = true

ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False) ' Or false, as the case may be

ChangeDBProperty_Exit:
   Exit Function

Err_ChangeDBProperty:
'ChangeDBProperty = true
    Select Case Err.Number  ' trap for the specified error number
        'Case
            'Resume next
        Case Else
            MsgBox Err.Number & " ~ " & Err.Description
    End Select
   
   Resume ChangeDBProperty_Exit

End Function


Well, you evaluate each property individually (for example, I look at just two of them)

   If (bolRetVal = True) Then
       'bolRetVal = ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
   Else
       ' Report error "property not found" to user.
       Err.Raise 3270
   End If
   
   ' Set the StartupShowDBWindow property.
   If (bolRetVal = True) Then
       'bolRetVal = ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False)
   Else
       ' Report error "property not found" to user.
       Err.Raise 3270
   End If

first, you check to see if a set boolean is true, you do that for all. If one of the properies does not evaluate to tru, the variable then is false for all the rest.
ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False)

If your concern that a a property does not exist or can error out, I would do this:

Public Function ChangeDBProperty(strPropertyName As String, varPropertyType As Variant, varPropertyValue As Variant) As Boolean ''True means successful'
on error goto Err_ChangeDBProperty

ChangeDBProperty = true

ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False) ' Or false, as the case may be

ChangeDBProperty_Exit:
   Exit Function

Err_ChangeDBProperty:
'ChangeDBProperty = true
    Select Case Err.Number  ' trap for the specified error number
        'Case
            'Resume next
        Case Else
            MsgBox Err.Number & " ~ " & Err.Description
    End Select
   
   Resume ChangeDBProperty_Exit

End Function


Well, you evaluate each property individually (for example, I look at just two of them)

   If (bolRetVal = True) Then
       'bolRetVal = ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
   Else
       ' Report error "property not found" to user.
       Err.Raise 3270
   End If
   
   ' Set the StartupShowDBWindow property.
   If (bolRetVal = True) Then
       'bolRetVal = ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False)
   Else
       ' Report error "property not found" to user.
       Err.Raise 3270
   End If

first, you check to see if a set boolean is true, you do that for all. If one of the properies does not evaluate to tru, the variable then is false for all the rest.
ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False)

If your concern that a a property does not exist or can error out, I would do this:

Public Function ChangeDBProperty(strPropertyName As String, varPropertyType As Variant, varPropertyValue As Variant) As Boolean ''True means successful'
on error goto Err_ChangeDBProperty

ChangeDBProperty = true

ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False) ' Or false, as the case may be

ChangeDBProperty_Exit:
   Exit Function

Err_ChangeDBProperty:
'ChangeDBProperty = true
    Select Case Err.Number  ' trap for the specified error number
        'Case
            'Resume next
        Case Else
            MsgBox Err.Number & " ~ " & Err.Description
    End Select
   
   Resume ChangeDBProperty_Exit

End Function


Well, you evaluate each property individually (for example, I look at just two of them)

   If (bolRetVal = True) Then
       'bolRetVal = ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
   Else
       ' Report error "property not found" to user.
       Err.Raise 3270
   End If
   
   ' Set the StartupShowDBWindow property.
   If (bolRetVal = True) Then
       'bolRetVal = ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False)
   Else
       ' Report error "property not found" to user.
       Err.Raise 3270
   End If

first, you check to see if a set boolean is true, you do that for all. If one of the properies does not evaluate to tru, the variable then is false for all the rest.
ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False)

If your concern that a a property does not exist or can error out, I would do this:

Public Function ChangeDBProperty(strPropertyName As String, varPropertyType As Variant, varPropertyValue As Variant) As Boolean ''True means successful'
on error goto Err_ChangeDBProperty

ChangeDBProperty = true

ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False) ' Or false, as the case may be

ChangeDBProperty_Exit:
   Exit Function

Err_ChangeDBProperty:
'ChangeDBProperty = true
    Select Case Err.Number  ' trap for the specified error number
        'Case
            'Resume next
        Case Else
            MsgBox Err.Number & " ~ " & Err.Description
    End Select
   
   Resume ChangeDBProperty_Exit

End Function


ASKER CERTIFIED SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Grr.. sent before I was finished!

the last part, again...

Public Function ChangeDBProperty(strPropertyName As String, varPropertyType As Variant, varPropertyValue As Variant) As Boolean ''True means successful'
on error goto Err_ChangeDBProperty

ChangeDBProperty = true

ChangeDBProperty("StartupForm", DB_Text, "frmSplashScreen")
ChangeDBProperty("StartupShowDBWindow", DB_Boolean, False) ' Or false, as the case may be

ChangeDBProperty_Exit:
  Exit Function

Err_ChangeDBProperty:

   'ChangeDBProperty = true   ' If you want to return a false for all errors
   Select Case Err.Number  ' trap for the specified error number
        'Case nnnn
           'ChangeDBProperty = true   ' If you want to return a false for just this error
           'Resume Next   ' Resume at the next line of code after the line that raised the error        
         'Case nnnn
           'ChangeDBProperty = true   ' If you want to return a false for just this error
           'Resume ChangeDBProperty_Exit   ' exit function
       Case Else
           'ChangeDBProperty = true   ' If you want to return a false for all untrapped errors
           MsgBox Err.Number & " ~ " & Err.Description
           ' Either
           ' Resume ChangeDBProperty_Exit
           ' Or
           ' Resume Next
   End Select

End Function
Avatar of wenyonk

ASKER

I have noticed the following property settings (if changed) don't take effect until the next time the application database opens and cannot be changed on the fly.

Description                                    Property Name                                Special note
-------------------------------------------------------------------------------------------------------------------------
Display Form/Page                        StartupForm
Display Database Window             StartupShowDBWindow
Display Status Bar                         StartupShowStatusBar
Menu Bar                                       StartupMenuBar                              Cannot contain Null value
Shortcut Menu Bar                         StartupShortcutMenuBar                Cannot contain Null value
Allow Full Menus                            AllowFullMenus
Allow Default Shortcut Menus        AllowShortcutMenus
Allow Built-In Toolbars                   AllowBuiltInToolbars
Allow Toolbar/Menu Changes        AllowToolbarChanges
Allow Viewing Code After Error      AllowBreakIntoCode
Use Access Special Keys                AllowSpecialKeys


The following property settings (if changed) will take effect immediatly after the Application.RefreshTitleBar method has been called.

Description                                    Property Name
---------------------------------------------------------------------------

Application Title                            AppTitle
Application Icon                            AppIcon
That's true, kind of handy if during runtime you need to change them (I do it in an app to keep a message up, ie
"My Great App"

When I am going to kick users out, I change the title to:
"My Great App is about to Undergo Maintenance, Please Exit Immediately""
wenyonk

Thanks for the points.

Remark to your point 5

For a new database a number of properties are not yet created by Access, this does not mean that they are not valid! All properties you listed are valid but some of them have to be created by your code.
You have therefore changed a little too much in the code provided by 1William. The errorhandler in his changeProperty function will make sure the property gets created when it does not exist, you took that part out. I would recommend to add the DDL parameter to this code.

I have changed your code, see end of comment.

' This property changes the current database properties passed to the values passed and returns the success
' or failure of doing so.  The true or false value mat be discarded or used for further code execution.
Public Function ChangeDBProperty(strPropertyName As String, varPropertyType As Variant, varPropertyValue As Variant) As Boolean

   On Error GoTo ChangeDBProperty_Error
   
   ' Declare local variables.
   Dim objCurrentDB As Object

   Const conPropNotFoundError = 3270

   ' initialize local variables.
   ' Sets the currentdb object to the current application db.
   Set objCurrentDB = Application.CurrentDb
 
   ' Sets the currentdb property passed to the value passed.
   objCurrentDB.Properties(strPropertyName) = varPropertyValue
   
   ' Return success in setting of specified property.
   ChangeDBProperty = True
   
ChangeDBProperty_Exit:
   Exit Function

ChangeDBProperty_Error:
   
   'Create the property if it does not exist
   If Err.Number = conPropNotFoundError Then    ' Property not found.
     Dim prp As DAO.Property

     Set prp = objCurrentDB.CreateProperty(strPropName, varPropType, varPropValue, True) 'Set the DDL parameter to true
     objCurrentDB.Properties.Append prp
     Resume Next
   End If

   ' Decalre local variables
   Dim strError As String
   
   ' Create error message string to send to message box
   strError = "Error Number:           " & Err.Number & vbCrLf & "Error Description:      " & Err.Description & "     "
   ' Move the query or command that caused the error to the ActionPerformedCodeSection property.
   ActionPerformedCodeSection = Err.Source
   ' Call to set module information in global variables.
   'SetModuleInformation
   ' Move the procedure or function name that caused the error to the ActionPerformed property.
   ActionPerformed = "ChangeDBProperty() Function"
   ' Set the CA MessageBoxError property to true to use application and module
   ' information in the CA augmented messagebox during an error condition.
   MessageBoxError = True
   MsgBox strError, vbExclamation, "ChangeDBProperty() Error"
   
   ' Return failure (error) in setting of specified property.
   ChangeDBProperty = False
   Resume ChangeDBProperty_Exit
   
' End of the ChangeDBProperty function.
End Function
Avatar of wenyonk

ASKER

Heer2351:

Your welcome for the points!  Below is the code I went with.  Any final comments?




' This function changes the current database properties passed to the values passed and returns the success
' or failure of doing so.  The true or false value may be discarded or used for further code execution.
'
' This function uses the DDL argument (fourth argument) to create a property that only Admins can change.
' Current CreateProperty listing in Access help is flawed in that anyone who can open the db can reset
' properties, such as AllowBypassKey.
Public Function ChangeDBProperty(strPropertyName As String, daoPropertyType As DAO.DataTypeEnum, varPropertyValue As Variant) As Boolean

    On Error GoTo ChangeDBProperty_Error
   
    ' Decalre local variables.
    ' Must add Microsoft DAO 3.6 or higher reference (Tools/References) to used these data types.
    Dim daoCurrentDB As DAO.Database
    Dim daoDDLProperty As DAO.Property
   
    ' Declare and initialize local contstants.
    Const conPropertyNotFound_Error = 3270
    Const conItemNotFoundInCollection_Error = 3265
   
    ' initialze local variables.
    ' Sets the currentdb object to the current application db.
    Set daoCurrentDB = Application.CurrentDb
     
    ' Assuming the current property was created without using the DDL argument. Delete it so we
    ' can recreate it properly.
    daoCurrentDB.Properties.Delete strPropertyName
   
    ' Sets the daoDDLProperty property passed to the value passed.
    Set daoDDLProperty = daoCurrentDB.CreateProperty(strPropertyName, daoPropertyType, varPropertyValue, True)
       
    ' Now, actually append the daoDDLProperty property to current list of database properties.
    daoCurrentDB.Properties.Append daoDDLProperty
   
    ' Return success in setting of specified property.
    ChangeDBProperty = True
   
ChangeDBProperty_Exit:
    ' Set the following dao objects to nothing so the cleanup process removes them from memory.
    Set daoCurrentDB = Nothing
    Set daoDDLProperty = Nothing
    ' Exit the function.
    Exit Function

ChangeDBProperty_Error:
   
    Select Case Err.Number
   
        Case conPropertyNotFound_Error  ' 3270
            ' We can ignore when the property does not exist.
            Resume Next
       
        Case conItemNotFoundInCollection_Error  ' 3265
            ' We can ignore Item is not found in collection.
            Resume Next
   
        Case Else
   
            ' Decalre local variables
            Dim strError As String

            ' Create error message string to send to message box
            strError = "Error Number:           " & Err.Number & vbCrLf & "Error Description:      " & Err.Description & "     "
            ' Move the query or command that caused the error to the ActionPerformedCodeSection property.
            ActionPerformedCodeSection = Err.Source
            ' Call to set module information in global variables.
            'SetModuleInformation
            ' Move the procedure or function name that caused the error to the ActionPerformed property.
            ActionPerformed = "ChangeDBProperty() Function"
            ' Set the CA MessageBoxError property to true to use application and module
            ' information in the CA augmented messagebox during an error condition.
            MessageBoxError = True
            MsgBox strError, vbExclamation, "ChangeDBProperty() Error"
   
            ' Return failure (error) in setting of specified property.
            ChangeDBProperty = False
            Resume ChangeDBProperty_Exit
   
    End Select
   
' End of the ChangeDBProperty function.
End Function
Good job.

I was thinking of posting a comment that you actually should delete a property and recreate it with the DDL property set to true for optimal security but got distracted. But you have added it yourself.

Error 3270 should not occur anymore since you are always creating the property, so you could remove that check from the error handler.
Avatar of wenyonk

ASKER

Thanks

WenyonK