Disabling the Shift Key

[johnwiseman]

Hello.

I have code which disables the shift key to prevent unauthorised access on MSaccess2003. I have imported it to a new database but it refuses to work with a vba error highlighting the line - db As DAO.Database

and the message "Compile Error - user defined type not defined"

Can anyone see where I have made a mistake?

Here is the modual code.

Option Compare Database
Option Explicit

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 'Property not found
Set prp = db.CreateProperty(strPropName, varPropType, varPropValue)
db.Properties.Append prp
Resume Next
Else
SetProperties = False
MsgBox "SetProperties", Err.Number, Err.Description
Resume Exit_SetProperties
End If
End Function


And here is the code attached to a cmd button.


Private Sub bDisableBypassKey_Click()
On Error GoTo Err_bDisableBypassKey_Click
Dim strInput As String
Dim strMsg As String
Beep
strMsg = "Do you want to enable the Bypass Key?" & vbCrLf & vbLf & _
"Please key the programmer's password to enable the Bypass Key."
strInput = InputBox(Prompt:=strMsg, title:="Disable Bypass Key Password")
If strInput = "password" Then
SetProperties "AllowBypassKey", dbBoolean, True
Beep
MsgBox "Correct password"
Else
Beep
SetProperties "AllowBypassKey", dbBoolean, False
MsgBox "Wrong Password"
Exit Sub
End If
Exit_bDisableBypassKey_Click:
Exit Sub
Err_bDisableBypassKey_Click:
MsgBox "bDisableBypassKey_Click", Err.Number, Err.Description
Resume Exit_bDisableBypassKey_Click
End Sub


Thanks in advance for any assistance.

 

[Golom]

Sounds like you've lost a reference. In a VB screen, look at Tools / References and look for any references marked "MISSING". The one you probably need is Microsoft DAO 3.6 Object Library

 

[genomon]

Also make sure that this is located above any ADO references by highlighting it & using the up arrow if needed.

"Teamwork means never having to take all the blame yourself."