【AccessVBA】Shiftキーを押しながら開く、を無効にする（AllowBypassKey）

Accessでアプリケーションを作成した際に、スタートアッププロパティやAutoExecマクロで指定したフォームを立ち上げたり既定の前処理を実施したりしますが、ユーザがShiftキーを押しながら開くことでそれらを無効にすることができてしまいます。今回は、そのShiftキーを押して開く動作を無効化する「AllowBypassKey」というものを紹介します。

  1. AllowBypassKeyプロパティの作成
  2. AllowBypassKeyの活用例

では、ひとつずつ見ていきましょう。

１．AllowBypassKeyプロパティの作成

AllowBypassKeyとは、Accessのデータベースファイルひとつひとつに持たせることができるプロパティのひとつです。新規に作成したデータベースファイルには、実はこのプロパティは存在していません。ですので、まずはプロパティの作り方を見てみましょう。

Public Function createABKproperty(ByVal bolValue As Boolean) As Long
    Dim varProperty As Variant
    Dim strPropName As String
    strPropName = "AllowBypassKey"
    Set varProperty = CurrentDb.CreateProperty(strPropName, _
                                               dbBoolean, _
                                               bolValue)
    CurrentDb.Properties.Append varProperty
End Function

この関数を実行するとAllowBypassKeyが作成されます。引数にTrueかFalseを渡すことで、渡した値を設定した状態で作成してくれます。

この処理は、AllowBypassKeyがすでに作成されているデータベースで実行するとエラーになってしまいます。実際に使う場合のサンプルコードとともに使い方を見ていきましょう。

２．AllowBypassKeyの活用例

まず、先ほどのプロパティ作成のコードと合わせて、AllowBypassKeyの制御のコードを完成させてしまいましょう。

Public Function changeABKproperty(ByVal bolValue As Boolean) As Long
    Dim strPropName As String
    Const conPropertyNoExistErrorCode = 3270
    On Error GoTo Error_End
    strPropName = "AllowBypassKey"
    CurrentDb.Properties(strPropName).Value = bolValue

    changeABKproperty = True
    GoTo End_Function
Error_End:
    If Err.Number = conPropertyNoExistErrorCode Then
        createABKproperty bolValue
    Else
        MsgBox Err.Description, vbOKOnly + vbCritical, "Error"
        changeABKproperty = False
    End If
End_Function:
End Function

「CurrentDb.Properties(strPropName).Value = bolValue」でプロパティを設定しようとしています。もしこの段階でデータベースにプロパティが存在しない場合は、エラーコード3270でエラーになります。その場合、「Error_End:」行以降の処理を実施することになり、そこで先ほど作ったプロパティを作成するFunctionが呼ばれることになります。

最後に、この関数を使って「Shiftキーを押しながら開く」を無効化したり有効化するための実装方法のサンプルを紹介します。

Public Sub checkABK()
    Dim strCheckFile As String
    Dim bolFlag As Boolean
    strCheckFile = "AllowBypassKeyLock.txt"
    If Dir(strGetCurrentPath & strCheckFile) <> "" Then
        bolFlag = True
    Else
        bolFlag = False
    End If
    changeABKproperty bolFlag
End Sub

Accessデータベースと同じフォルダに「AllowBypassKeyLock.txt」というファイルが存在すれば「Shiftキーを押しながら開く」を有効にし、存在しなければ無効にする、というプロシージャです。なお、コード内の「strGetCurrentPath」は【AccessVBA】開いているAccessファイルの場所を取得するで作成したカレントパスを取得する関数です。これを、【AccessVBA/ExcelVBA】Dir関数の便利な実用例で学んだ存在チェックと組み合わせています。

AutoExecマクロで上記のコードを起動時に実行するようセットしておけば、テキストファイルの有無でモードをコントロールできるようになりますね。