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 

调用方法： 
ChangeProperty "AllowBypassKey", 1, False　'false为禁止SHIFT键，TRUE为恢复

注意：
如果需要防止别人使用改变属性的方法来打开，还需在权限组里禁止管理员对属性的设置