Hi
Create a public module like
Public Function SetProperties(strPropName As String, varPropType As Variant,
varPropValue As Variant) As Integer
On Error GoTo Err_SetProperties
Dim db As DAO.Database, prp As DAO.Property
Set db = CurrentDb
db.Properties(strPropName) = varPropValue
SetProperties = True
Set db = Nothing
Exit_SetProperties:
Exit Function
Err_SetProperties:
If Err = 3270 Then
Set prp = db.CreateProperty(strPropName, varPropType, varPropValue)
db.Properties.Append prp
Resume Next
Else
SetProperties = False
MsgBox "Runtime Error # " & Err.Number & vbCrLf & vbLf & Err.Description
Resume Exit_SetProperties
End If
End Function
Next Create a button (called ByPassButton) on a form
Put this OnClick
Note
This will disable to shift key and allow you (or anyone else with the
password) to reset it) but it will NOT (in anyway) secure the database.
For this I have used
"INSERT PASSWORD HERE"
as the password - without the commas, I would change it if I were you
Private Sub ByPassButton_Click()
On Error GoTo Err_ByPassButton_Click
Dim strSomeThing As String
Dim strMsg As String
Beep
strMsg = "You can enable the Shift Key by putting in the password into the
box" _
& vbCrLf & vbLf & "Warning" & vbCrLf & vbLf & _
"If you change the codes and design functions in this database" _
& vbLf & "it may become unworkable and you could lose all the data" _
& vbLf & vbLf & "If you don't have the password, please contact me."
strSomeThing = InputBox(Prompt:=strMsg, Title:="Message from ?????")
If strInput = "INSERT PASSWORD HERE" Then
'Change the above to what you want BUT DON'T FORGET IT
SetProperties "AllowBypassKey", dbBoolean, True
Beep
MsgBox "Next time you open the Database, hold down the Shift key.", _
vbInformation, "Message from **** - Correct password"
Else
Beep
SetProperties "AllowBypassKey", dbBoolean, False
MsgBox "Incorrect Password!" & vbCrLf & vbLf & _
"You can't use this shift key.", _
vbCritical, "Message from ?*?*?*"
Exit Sub
End If
Exit_ByPassButton_Click:
Exit Sub
Err_ByPassButton_Click:
MsgBox "Runtime Error # " & Err.Number
Resume Exit_ByPassButton_Click
End Sub
Change the messages to whatever you want.
Give it a try and let us know if you have problems - am sure someone will be
able to help
Good luck
