設置只有管理員才能改變AllowBypassKey屬性

tmtony翻譯：

在Access的幫助文件中說明CreateProperty 方法的語法：

Set property = object.CreateProperty (name, type, value, DDL)
其實最後一個參數是這個解釋的（部分描述）：

DDL 可選. 一個變量(邏輯子類型) 指定這個屬性是否為DDL對象. 缺少值為False. 如果設置為TRUE，除非他有 dbSecWriteDef 權限，用戶就不能改變或刪除這個屬性
CreateProperty 是用來創建或設置 AllowBypassKey 屬性如果這個屬性設為TRUE, 那就可以禁用戶近SHIFT鍵來禁止啟動屬性和AutoExec 宏. 然而，ACCESS幫助中提供的例子沒有使用第四個 DDL 參數. 這意味著任何人都可以打開數據據然後用程序復位AllowBypassKey 屬性.

所以，為了限制普通用戶去改變這個屬性，所以我們設置第四個參數為TRUE 。

為了對比，我們也同時列出了ACCESS本身的例子以便參照

' *********** Code Start ***********
Function ChangePropertyDdl(stPropName As String, _
PropType As DAO.DataTypeEnum, vPropVal As Variant) _
As Boolean
' Uses the DDL 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
'
On Error GoTo ChangePropertyDdl_Err

Dim db As DAO.Database
Dim prp As DAO.Property

Const conPropNotFoundError = 3270

Set db = CurrentDb
' Assuming the current property was created without
' using the DDL argument. Delete it so we can
' recreate it properly
db.Properties.Delete stPropName
Set prp = db.CreateProperty(stPropName, _
PropType, vPropVal, True)
db.Properties.Append prp

' If we made it this far, it worked!
ChangePropertyDdl = True

ChangePropertyDdl_Exit:
Set prp = Nothing
Set db = Nothing
Exit Function

ChangePropertyDdl_Err:
If Err.Number = conPropNotFoundError Then
' We can ignore when the prop does not exist
Resume Next
End If
Resume ChangePropertyDdl_Exit
End Function

幫助本身的例子
Function ChangeProperty(strPropName As String, _
varPropType As Variant, varPropValue As Variant) As Integer
' The current listing in Access help file which will
' let anyone who can open the db delete/reset any
' property created by using this function, since
' the call to CraeteProperty doesn't use the DDL
' argument
'
Dim dbs As Database, prp As Property
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
' *********** Code End ***********