' *********** 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 ***********