How do I use parameters in VBA in the different contexts in Microsoft Access?

后端 未结 2 1297
爱一瞬间的悲伤
爱一瞬间的悲伤 2020-11-21 23:40

I\'ve read a lot about SQL injection, and using parameters, from sources like bobby-tables.com. However, I\'m working with a complex application in Access, that has a lot of

相关标签:
2条回答
  • 2020-11-22 00:03

    There are many ways to use parameters in queries. I will try to provide examples for most of them, and where they are applicable.

    First, we'll discuss the solutions unique to Access, such as forms, reports and domain aggregates. Then, we'll talk about DAO and ADO.


    Using values from forms and reports as parameters

    In Access, you can directly use the current value of controls on forms and reports in your SQL code. This limits the need for parameters.

    You can refer to controls in the following way:

    Forms!MyForm!MyTextbox for a simple control on a form

    Forms!MyForm!MySubform.Form!MyTextbox for a control on a subform

    Reports!MyReport!MyTextbox for a control on a report

    Sample implementation:

    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
    

    This is available for the following uses:

    When using DoCmd.RunSQL, normal queries (in the GUI), form and report record sources, form and report filters, domain aggregates, DoCmd.OpenForm and DoCmd.OpenReport

    This is not available for the following uses:

    When executing queries using DAO or ADODB (e.g. opening recordsets, CurrentDb.Execute)


    Using TempVars as parameters

    TempVars in Access are globally available variables, that can be set in VBA or using macro's. They can be reused for multiple queries.

    Sample implementation:

    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
    

    Availability for TempVars is identical to that of values from forms and reports: not available for ADO and DAO, available for other uses.

    I recommend TempVars for using parameters when opening forms or reports over referring to control names, since if the object opening it closes, the TempVars stay available. I recommend using unique TempVar names for every form or report, to avoid weirdness when refreshing forms or reports.


    Using custom functions (UDFs) as parameters

    Much like TempVars, you can use a custom function and static variables to store and retrieve values.

    Sample implementation:

    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
    

    and then:

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

    Also, a single function with an optional parameter may be created for both setting and getting the value of a private static variable:

    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
    

    To set a value:

    ThisValue "Some text value"
    

    To get the value:

    CurrentValue = ThisValue
    

    In a query:

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

    Using DoCmd.SetParameter

    The uses of DoCmd.SetParameter are rather limited, so I'll be brief. It allows you to set a parameter for use in DoCmd.OpenForm, DoCmd.OpenReport and some other DoCmd statements, but it doesn't work with DoCmd.RunSQL, filters, DAO and ADO.

    Sample implementation

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

    Using DAO

    In DAO, we can use the DAO.QueryDef object to create a query, set parameters, and then either open up a recordset or execute the query. You first set the queries' SQL, then use the QueryDef.Parameters collection to set the parameters.

    In my example, I'm going to use implicit parameter types. If you want to make them explicit, add a PARAMETERS declaration to your query.

    Sample implementation

    '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
    

    While this is only available in DAO, you can set many things to DAO recordsets to make them use parameters, such as form recordsets, list box recordsets and combo box recordsets. However, since Access uses the text, and not the recordset, when sorting and filtering, those things may prove problematic if you do.


    Using ADO

    You can use parameters in ADO by using the ADODB.Command object. Use Command.CreateParameter to create parameters, and then append them to the Command.Parameters collection.

    You can use the .Parameters collection in ADO to explicitly declare parameters, or pass a parameter array to the Command.Execute method to implicitly pass parameters.

    ADO does not support named parameters. While you can pass a name, it's not processed.

    Sample implementation:

    '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
    

    The same limitations as opening DAO recordsets apply. While this way is limited to executing queries and opening recordsets, you can use those recordsets elsewhere in your application.

    0 讨论(0)
  • 2020-11-22 00:11

    I have built a fairly basic query builder class to get around the mess of string concatenation and to handle the lack of named parameters. Creating a query is fairly simple.

    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
    

    The output of the ToString() method looks like:

    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;

    Each predicate is wrapped in parens to handle linked AND/OR clauses, and parameters with the same name only have to be declared once. Full code is at my github and reproduced below. I also have a version for Oracle passthrough queries that uses ADODB parameters. Eventually, I'd like to wrap both in an IQueryBuilder interface.


    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
    
    ' =============================================================================
    
    0 讨论(0)
提交回复
热议问题