[b]The following is conatined within the form module[/b]
'=====================================================
Private Sub cmdLockDB_Click()
ChangeProperty "AllowBypassKey", dbBoolean, False
MsgBox "Database Now Locked", vbOKOnly
End Sub
'=====================================================
Private Function CheckPassword()
If Me.txtPassword = "stacemppp" Then
MsgBox "Password Accepted", _
vbOKOnly, "Welcome Database Administrator"
If CheckBypass = False Then 'Bypass not allowed as previously locked
Me.cmdLockDB.Enabled = False
Me.cmdUnlockDB.Enabled = True
Me.cmdUnlockDB.SetFocus
Else
Me.cmdUnlockDB.Enabled = False
Me.cmdLockDB.Enabled = True
Me.cmdLockDB.SetFocus
End If
Me.txtPassword.Enabled = False
Exit Function
Else
MsgBox "Incorrect Password Entered, Application will now shutdown", vbOKOnly, "Password Unaccepted"
DoCmd.Quit
Me.txtPassword = Null
End If
End Function
'=====================================================
Private Sub cmdUnlockDB_Click()
ChangeProperty "AllowBypassKey", dbBoolean, True
MsgBox "Database Unlocked for modification" & vbCr & "Database will now quit and you will need to re-open using the Shift F1 keys", _
vbOKOnly, "Database Unlocked!"
DoCmd.Quit
End Sub
'=====================================================
Private Sub Form_Open(Cancel As Integer)
Me.cmdUnlockDB.Enabled = False
Me.cmdLockDB.Enabled = False
End Sub
'=====================================================
Private Sub txtPassword_AfterUpdate()
CheckPassword
End Sub
'=====================================================
[b]The following is contained within a Database module[/b]
'=====================================================
Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
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
Set prp = dbs.CreateProperty(strPropName, varPropType, varPropValue)
dbs.Properties.Append prp
Resume Next
Else
ChangeProperty = False
Resume Change_Bye
End If
End Function
Function CheckBypass() As Integer
Dim dbs As Object, prp As Variant
Const conPropNotFoundError = 3270
Set dbs = CurrentDb
On Error GoTo Check_Err
If dbs.Properties("AllowBypassKey") = True Then
CheckBypass = True
Else
CheckBypass = False
End If
Check_Bye:
Exit Function
Check_Err:
If Err = conPropNotFoundError Then ' Property not found.
Set prp = dbs.CreateProperty("AllowBypassKey", _
DB_BOOLEAN, True)
dbs.Properties.Append prp
Resume Next
Else
' Unknown error.
Resume Check_Bye
End If
End Function
