【VBA】Access起動時のShiftキーを制御する（有効化/無効化）

ShiftKeyControl.vba

'***************************************************************************************************
'関数名：EnableShiftKey
'機　能：起動時のShiftKeyの有効化します。
'***************************************************************************************************
Public Function EnableShiftKey()
    SwitchShiftKey True
End Function

'***************************************************************************************************
'関数名：DisableShiftKey
'機　能：起動時のShiftKeyの無効化します。
'***************************************************************************************************
Public Function DisableShiftKey()
    SwitchShiftKey False
End Function

'***************************************************************************************************
'関数名：SwitchShiftKey
'引　数：True（有効）、False（無効）
'機　能：起動時のShiftKeyの有効・無効を制御します。
'***************************************************************************************************
Public Function SwitchShiftKey(ByVal varPropValue As Boolean) As Boolean
On Error GoTo Error
    Dim strPropName As String
    Dim varPropType
    Dim db As DAO.Database
    Dim prp As DAO.Property
    Const conPropNotFoundError = 3270
    strPropName = "AllowBypassKey"
    varPropType = dbBoolean
    Set db = CurrentDb
    db.Properties(strPropName) = varPropValue
    SwitchShiftKey = True
Exit Function
Error:
    If Err.Number = conPropNotFoundError Then
        'プロパティが見つからない場合は追加する（初回時のみ）
        Set prp = db.CreateProperty(strPropName, varPropType, varPropValue)
        db.Properties.Append prp
        Resume Next
    Else
        SwitchShiftKey = False ' 認識できないエラー。
        Exit Function
    End If
End Function

'***************************************************************************************************
'関数名：ShiftKey
'引　数：True（有効）、False（無効）
'機　能：起動時のShiftKeyの有効・無効を表示します。
'***************************************************************************************************
Public Function ShiftKey() As Boolean
On Error GoTo Error
    Dim strPropName As String
    Dim varPropType
    Dim db As DAO.Database
    Dim prp As DAO.Property
    Const conPropNotFoundError = 3270
    strPropName = "AllowBypassKey"
    varPropType = dbBoolean
    Set db = CurrentDb
    If db.Properties(strPropName).Value Then
        ShiftKey = True
    Else
        ShiftKey = False
    End If
Exit Function
Error:
    ShiftKey = True
End Function