No Shift Key

Option Compare Database
Option Explicit


Function ChangeProperty(strPropName As String, varPropType, varPropValue) As Integer
On Error GoTo Err_Allow_Shift
    Dim dbPro As Database, prpPro As Property
    Const conPropNotFoundError = 3270
    Set dbPro = CurrentDb
    dbPro.Properties(strPropName) = varPropValue
    ChangeProperty = True
    Exit Function
Err_Allow_Shift:
    If Err = conPropNotFoundError Then
        Set prpPro = dbPro.CreateProperty(strPropName, varPropType, varPropValue)
        dbPro.Properties.Append prpPro
        Resume Next
    Else
        ChangeProperty = False
        Exit Function
    End If
End Function



Function NoShiftKey(flgAsk As Boolean)
    If flgAsk = True Then
        ChangeProperty "AllowBypassKey", dbBoolean, True   '使用可
    Else
        ChangeProperty "AllowBypassKey", dbBoolean, False   '使用不可
    End If

End Function