Microsoft AccessのさまざまなコンテキストでVBAのパラメーターを使用するにはどうすればよいですか？

Question

bobby-tables.com のようなソースから、SQLインジェクションとパラメーターの使用について多くを読みました。ただし、私はAccessで複雑なアプリケーションを使用しています。このアプリケーションには、さまざまな場所で文字列を連結する動的SQLがたくさんあります。

エラーを回避し、Jack O'Connelのように単一引用符で名前を処理できるように、変更およびパラメーターを追加したい次の事項があります。

それは使用しています：

• DoCmd.RunSQLはSQLコマンドを実行します
• DAOレコードセット
• ADODBレコードセット
• WhereCondition引数で文字列連結を使用して、DoCmd.OpenFormおよびDoCmd.OpenReportで開かれたフォームおよびレポート
• 文字列連結を使用するDLookUpのようなドメイン集約

クエリは主に次のように構成されています。

DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE ID = " & Me.SomeTextbox

これらの異なる種類のクエリにパラメーターを使用するためのオプションは何ですか？

_{この質問は、さまざまな投稿に頻繁にパラメータコメントを使用するためのリソースとして意図されています}

Answer 1

クエリでパラメータを使用するには多くの方法があります。それらのほとんどの例とそれらが適用できる場所を提供するように努めます。

最初に、フォーム、レポート、ドメイン集計など、Accessに固有のソリューションについて説明します。次に、DAOとADOについて説明します。

---

フォームとレポートの値をパラメーターとして使用する

Accessでは、フォームおよびレポートのコントロールの現在の値をSQLコードで直接使用できます。これにより、パラメーターの必要性が制限されます。

次の方法でコントロールを参照できます。

Forms!MyForm!MyTextboxは、フォーム上の単純なコントロールの場合

Forms!MyForm!MySubform.Form!MyTextboxサブフォーム上のコントロール

Reports!MyReport!MyTextboxレポートのコントロール

実装例：

DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Forms!MyForm!MyTextbox" 'Inserts a single value
DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE ID = Forms!MyForm!MyTextbox" 'Inserts from a different table

これは次の用途に使用できます：

DoCmd.RunSQLを使用する場合、通常のクエリ（GUI）、フォームとレポートのレコードソース、フォームとレポートのフィルター、ドメイン集計、DoCmd.OpenFormおよびDoCmd.OpenReport

これは次の用途では使用できません：

DAOまたはADODBを使用してクエリを実行する場合（例：レコードセットを開く、CurrentDb.Execute）

---

TempVarsをパラメーターとして使用する

AccessのTempVarはグローバルに利用可能な変数であり、VBAで設定するか、マクロを使用して設定できます。複数のクエリで再利用できます。

実装例：

TempVars!MyTempVar = Me.MyTextbox.Value 'Note: .Value is required
DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE ID = TempVars!MyTempVar"
TempVars.Remove "MyTempVar" 'Unset TempVar when you're done using it

TempVarsの可用性は、フォームおよびレポートの値の可用性と同じです。ADOおよびDAOでは使用できません。他の用途で使用できます。

フォームまたはレポートを開くときにパラメーターを使用する場合は、コントロール名を参照するよりもTempVarsをお勧めします。それを開くオブジェクトが閉じても、TempVarは利用可能なままだからです。フォームまたはレポートを更新するときの奇妙さを避けるために、すべてのフォームまたはレポートに一意のTempVar名を使用することをお勧めします。

---

カスタム関数（UDF）をパラメーターとして使用する

TempVarsと同様に、カスタム関数と静的変数を使用して、値を格納および取得できます。

実装例：

Option Compare Database
Option Explicit

Private ThisDate As Date


Public Function GetThisDate() As Date
    If ThisDate = #12:00:00 AM# Then
        ' Set default value.
        ThisDate = Date
    End If 
    GetThisDate = ThisDate
End Function


Public Function SetThisDate(ByVal NewDate As Date) As Date
    ThisDate = NewDate
    SetThisDate = ThisDate
End Function

その後：

SetThisDate SomeDateValue ' Will store SomeDateValue in ThisDate.
DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE [SomeDateField] = GetThisDate()"

また、single関数とoptionalパラメータを指定して、プライベート静的変数の設定と取得の両方を行うこともできます。

Public Function ThisValue(Optional ByVal Value As Variant) As Variant
    Static CurrentValue As Variant
    ' Define default return value.
    Const DefaultValue  As Variant = Null

    If Not IsMissing(Value) Then
        ' Set value.
        CurrentValue = Value
    ElseIf IsEmpty(CurrentValue) Then
        ' Set default value
        CurrentValue = DefaultValue
    End If
    ' Return value.
    ThisValue = CurrentValue
End Function

値を設定するには：

ThisValue "Some text value"

値を取得するには：

CurrentValue = ThisValue

クエリでは：

ThisValue "SomeText"  ' Set value to filter on.
DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE [SomeField] = ThisValue()"

---

DoCmd.SetParameterの使用

DoCmd.SetParameterの使用はかなり制限されているので、簡単に説明します。 DoCmd.OpenForm、DoCmd.OpenReportおよびその他のDoCmdステートメントで使用するパラメーターを設定できますが、DoCmd.RunSQL、フィルター、DAOおよびADOでは機能しません。

実装例

DoCmd.SetParameter "MyParameter", Me.MyTextbox
DoCmd.OpenForm "MyForm",,, "ID = MyParameter"

---

DAOの使用

DAOでは、DAO.QueryDefオブジェクトを使用してクエリを作成し、パラメーターを設定してから、レコードセットを開くか、クエリを実行します。最初にクエリのSQLを設定し、次にQueryDef.Parametersコレクションを使用してパラメーターを設定します。

私の例では、暗黙のパラメーター型を使用します。それらを明示的にしたい場合は、クエリに PARAMETERS宣言 を追加します。

実装例

'Execute query, unnamed parameters
With CurrentDb.CreateQueryDef("", "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE Field1 = ?p1 And Field2 = ?p2")
    .Parameters(0) = Me.Field1
    .Parameters(1) = Me.Field2
    .Execute
End With

'Open recordset, named parameters
Dim rs As DAO.Recordset
With CurrentDb.CreateQueryDef("", "SELECT Field1 FROM Table2 WHERE Field1 = FirstParameter And Field2 = SecondParameter")
    .Parameters!FirstParameter = Me.Field1 'Bang notation
    .Parameters("SecondParameter").Value = Me.Field2 'More explicit notation
    Set rs = .OpenRecordset
End With

これはDAOでのみ使用できますが、フォームレコードセット、リストボックスレコードセット、コンボボックスレコードセットなどのパラメーターを使用するように、DAOレコードセットに多くのものを設定できます。ただし、Accessはレコードセットではなくテキストを使用するため、並べ替えやフィルター処理を行うときに問題が発生する可能性があります。

---

ADOの使用

ADOでパラメーターを使用するには、ADODB.Commandオブジェクトを使用します。Command.CreateParameterを使用してパラメーターを作成し、Command.Parametersコレクションに追加します。

ADO=の.Parametersコレクションを使用して明示的にパラメーターを宣言するか、パラメーター配列をCommand.Executeメソッドに渡して暗黙的にパラメーターを渡すことができます。

ADOは名前付きパラメーターをサポートしていません。名前を渡すことはできますが、処理されません。

実装例：

'Execute query, unnamed parameters
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
With cmd
    Set .ActiveConnection = CurrentProject.Connection 'Use a connection to the current database
    .CommandText = "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE Field1 = ? And Field2 = ?"
    .Parameters.Append .CreateParameter(, adVarWChar, adParamInput, Len(Me.Field1), Me.Field1) 'adVarWChar for text boxes that may contain unicode
    .Parameters.Append .CreateParameter(, adInteger, adParamInput, 8, Me.Field2) 'adInteger for whole numbers (long or integer)
    .Execute
End With

'Open recordset, implicit parameters
Dim rs As ADODB.Recordset
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
With cmd
    Set .ActiveConnection = CurrentProject.Connection 'Use a connection to the current database
    .CommandText = "SELECT Field1 FROM Table2 WHERE Field1 = @FirstParameter And Field2 = @SecondParameter"
     Set rs = .Execute(,Array(Me.Field1, Me.Field2))
End With

DAOレコードセットを開くのと同じ制限が適用されます。この方法はクエリの実行とレコードセットのオープンに限定されていますが、アプリケーションの他の場所でそれらのレコードセットを使用できます。

Answer 2

文字列連結の混乱を回避し、名前付きパラメーターの欠如を処理するために、かなり基本的なクエリビルダークラスを作成しました。クエリの作成はかなり簡単です。

Public Function GetQuery() As String

    With New MSAccessQueryBuilder
        .QueryBody = "SELECT * FROM tblEmployees"

        .AddPredicate "StartDate > @StartDate OR StatusChangeDate > @StartDate"
        .AddPredicate "StatusIndicator IN (@Active, @LeaveOfAbsence) OR Grade > @Grade"
        .AddPredicate "Salary > @SalaryThreshhold"
        .AddPredicate "Retired = @IsRetired"

        .AddStringParameter "Active", "A"
        .AddLongParameter "Grade", 10
        .AddBooleanParameter "IsRetired", False
        .AddStringParameter "LeaveOfAbsence", "L"
        .AddCurrencyParameter "SalaryThreshhold", 9999.99@
        .AddDateParameter "StartDate", #3/29/2018#

        .QueryFooter = "ORDER BY ID ASC"
        GetQuery = .ToString

    End With

End Function

ToString（）メソッドの出力は次のようになります。

SELECT * FROM tblEmployees WHERE 1 = 1 AND（StartDate>＃3/29/2018＃OR StatusChangeDate>＃3/29/2018＃）AND（StatusIndicator IN（ 'A'、 'L '）OR Grade> 10）AND（Salary> 9999.99）AND（Retired = False）ORDER BY ID ASC;

各述語は括弧で囲まれ、リンクされたAND/OR句を処理します。同じ名前のパラメーターは、一度だけ宣言する必要があります。完全なコードはmy github にあり、以下に再現されています。また、ADODBパラメータを使用するOracleパススルークエリ用の version もあります。最終的には、両方をIQueryBuilderインターフェイスでラップしたいと思います。

---

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "MSAccessQueryBuilder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'@Folder("VBALibrary.Data")
'@Description("Provides tools to construct Microsoft Access SQL statements containing predicates and parameters.")

Option Explicit

Private Const mlngErrorNumber As Long = vbObjectError + 513
Private Const mstrClassName As String = "MSAccessQueryBuilder"
Private Const mstrParameterExistsErrorMessage As String = "A parameter with this name has already been added to the Parameters dictionary."

Private Type TSqlBuilder
    QueryBody As String
    QueryFooter As String
End Type

Private mobjParameters As Object
Private mobjPredicates As Collection
Private this As TSqlBuilder


' =============================================================================
' CONSTRUCTOR / DESTRUCTOR
' =============================================================================

Private Sub Class_Initialize()
    Set mobjParameters = CreateObject("Scripting.Dictionary")
    Set mobjPredicates = New Collection
End Sub


' =============================================================================
' PROPERTIES
' =============================================================================

'@Description("Gets or sets the query statement (SELECT, INSERT, UPDATE, DELETE), exclusive of any predicates.")
Public Property Get QueryBody() As String
    QueryBody = this.QueryBody
End Property
Public Property Let QueryBody(ByVal Value As String)
    this.QueryBody = Value
End Property

'@Description("Gets or sets post-predicate query statements (e.g., GROUP BY, ORDER BY).")
Public Property Get QueryFooter() As String
    QueryFooter = this.QueryFooter
End Property
Public Property Let QueryFooter(ByVal Value As String)
    this.QueryFooter = Value
End Property


' =============================================================================
' PUBLIC METHODS
' =============================================================================

'@Description("Maps a boolean parameter and its value to the query builder.")
'@Param("strName: The parameter's name.")
'@Param("blnValue: The parameter's value.")
Public Sub AddBooleanParameter(ByVal strName As String, ByVal blnValue As Boolean)
    If mobjParameters.Exists(strName) Then
        Err.Raise mlngErrorNumber, mstrClassName & ".AddBooleanParameter", mstrParameterExistsErrorMessage
    Else
        mobjParameters.Add strName, CStr(blnValue)
    End If
End Sub

' =============================================================================

'@Description("Maps a currency parameter and its value to the query builder.")
'@Param("strName: The parameter's name.")
'@Param("curValue: The parameter's value.")
Public Sub AddCurrencyParameter(ByVal strName As String, ByVal curValue As Currency)
    If mobjParameters.Exists(strName) Then
        Err.Raise mlngErrorNumber, mstrClassName & ".AddCurrencyParameter", mstrParameterExistsErrorMessage
    Else
        mobjParameters.Add strName, CStr(curValue)
    End If
End Sub

' =============================================================================

'@Description("Maps a date parameter and its value to the query builder.")
'@Param("strName: The parameter's name.")
'@Param("dtmValue: The parameter's value.")
Public Sub AddDateParameter(ByVal strName As String, ByVal dtmValue As Date)
    If mobjParameters.Exists(strName) Then
        Err.Raise mlngErrorNumber, mstrClassName & ".AddDateParameter", mstrParameterExistsErrorMessage
    Else
        mobjParameters.Add strName, "#" & CStr(dtmValue) & "#"
    End If
End Sub

' =============================================================================

'@Description("Maps a long parameter and its value to the query builder.")
'@Param("strName: The parameter's name.")
'@Param("lngValue: The parameter's value.")
Public Sub AddLongParameter(ByVal strName As String, ByVal lngValue As Long)
    If mobjParameters.Exists(strName) Then
        Err.Raise mlngErrorNumber, mstrClassName & ".AddNumericParameter", mstrParameterExistsErrorMessage
    Else
        mobjParameters.Add strName, CStr(lngValue)
    End If
End Sub

' =============================================================================

'@Description("Adds a predicate to the query's WHERE criteria.")
'@Param("strPredicate: The predicate text to be added.")
Public Sub AddPredicate(ByVal strPredicate As String)
    mobjPredicates.Add "(" & strPredicate & ")"
End Sub

' =============================================================================

'@Description("Maps a string parameter and its value to the query builder.")
'@Param("strName: The parameter's name.")
'@Param("strValue: The parameter's value.")
Public Sub AddStringParameter(ByVal strName As String, ByVal strValue As String)
    If mobjParameters.Exists(strName) Then
        Err.Raise mlngErrorNumber, mstrClassName & ".AddStringParameter", mstrParameterExistsErrorMessage
    Else
        mobjParameters.Add strName, "'" & strValue & "'"
    End If
End Sub

' =============================================================================

'@Description("Parses the query, its predicates, and any parameter values, and outputs an SQL statement.")
'@Returns("A string containing the parsed query.")
Public Function ToString() As String

Dim strPredicatesWithValues As String

    Const strErrorSource As String = "QueryBuilder.ToString"

    If this.QueryBody = vbNullString Then
        Err.Raise mlngErrorNumber, strErrorSource, "No query body is currently defined. Unable to build valid SQL."
    End If
    ToString = this.QueryBody

    strPredicatesWithValues = ReplaceParametersWithValues(GetPredicatesText)
    EnsureParametersHaveValues strPredicatesWithValues

    If Not strPredicatesWithValues = vbNullString Then
        ToString = ToString & " " & strPredicatesWithValues
    End If

    If Not this.QueryFooter = vbNullString Then
        ToString = ToString & " " & this.QueryFooter & ";"
    End If

End Function


' =============================================================================
' PRIVATE METHODS
' =============================================================================

'@Description("Ensures that all parameters defined in the query have been provided a value.")
'@Param("strQueryText: The query text to verify.")
Private Sub EnsureParametersHaveValues(ByVal strQueryText As String)

Dim strUnmatchedParameter As String
Dim lngMatchedPoisition As Long
Dim lngWordEndPosition As Long

    Const strProcedureName As String = "EnsureParametersHaveValues"

    lngMatchedPoisition = InStr(1, strQueryText, "@", vbTextCompare)
    If lngMatchedPoisition <> 0 Then
        lngWordEndPosition = InStr(lngMatchedPoisition, strQueryText, Space$(1), vbTextCompare)
        strUnmatchedParameter = Mid$(strQueryText, lngMatchedPoisition, lngWordEndPosition - lngMatchedPoisition)
    End If

    If Not strUnmatchedParameter = vbNullString Then
        Err.Raise mlngErrorNumber, mstrClassName & "." & strProcedureName, "Parameter " & strUnmatchedParameter & " has not been provided a value."
    End If

End Sub

' =============================================================================

'@Description("Combines each predicate in the predicates collection into a single string statement.")
'@Returns("A string containing the text of all predicates added to the query builder.")
Private Function GetPredicatesText() As String

Dim strPredicates As String
Dim vntPredicate As Variant

    If mobjPredicates.Count > 0 Then
        strPredicates = "WHERE 1 = 1"
        For Each vntPredicate In mobjPredicates
            strPredicates = strPredicates & " AND " & CStr(vntPredicate)
        Next vntPredicate
    End If

    GetPredicatesText = strPredicates

End Function

' =============================================================================

'@Description("Replaces parameters in the predicates statements with their provided values.")
'@Param("strPredicates: The text of the query's predicates.")
'@Returns("A string containing the predicates text with its parameters replaces by their provided values.")
Private Function ReplaceParametersWithValues(ByVal strPredicates As String) As String

Dim vntKey As Variant
Dim strParameterName As String
Dim strParameterValue As String
Dim strPredicatesWithValues As String

    Const strProcedureName As String = "ReplaceParametersWithValues"

    strPredicatesWithValues = strPredicates
    For Each vntKey In mobjParameters.Keys
        strParameterName = CStr(vntKey)
        strParameterValue = CStr(mobjParameters(vntKey))

        If InStr(1, strPredicatesWithValues, "@" & strParameterName, vbTextCompare) = 0 Then
            Err.Raise mlngErrorNumber, mstrClassName & "." & strProcedureName, "Parameter " & strParameterName & " was not found in the query."
        Else
            strPredicatesWithValues = Replace(strPredicatesWithValues, "@" & strParameterName, strParameterValue, 1, -1, vbTextCompare)
        End If
    Next vntKey

    ReplaceParametersWithValues = strPredicatesWithValues

End Function

' =============================================================================