如何在 Microsoft Access 的不同上下文中使用 VBA 中的参数？

Posted 2023-03-27

技术标签:

【中文标题】如何在 Microsoft Access 的不同上下文中使用 VBA 中的参数？【英文标题】：How do I use parameters in VBA in the different contexts in Microsoft Access? 【发布时间】：2018-09-05 16:04:04 【问题描述】：

我从bobby-tables.com 等来源阅读了很多关于 SQL 注入和使用参数的信息。但是，我正在使用 Access 中的一个复杂应用程序，它有很多动态 SQL，在各种地方都带有字符串连接。

它有以下我想要更改和添加参数的内容，以避免错误并允许我处理带有单引号的名称，例如 Jack O'Connel。

它使用：

DoCmd.RunSQL执行SQL命令 DAO 记录集 ADODB 记录集表单和报告，以DoCmd.OpenForm 和DoCmd.OpenReport 打开，在WhereCondition 参数中使用字符串连接 DLookUp 等使用字符串连接的域聚合

查询的结构大多是这样的：

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

对于这些不同类型的查询，我有哪些选择使用参数？

_{这个问题是一个资源，对于频繁的我如何使用参数对各种帖子的评论}

【问题讨论】：

这个问题是专门关于使用参数的，但可能值得注意的是，您可以通过使用 Gustav 的 CSql() function 安全地使用字符串连接。 【参考方案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 在打开表单或报告时使用参数而不是引用控件名称，因为如果打开它的对象关闭，TempVars 仍然可用。我建议为每个表单或报表使用唯一的 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 函数，用于设置和获取私有静态变量的值：

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 declaration。

示例实现

'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

您可以通过ADODB.Command 对象在ADO 中使用参数。使用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 记录集相同的限制。虽然这种方式仅限于执行查询和打开记录集，但您可以在应用程序的其他地方使用这些记录集。

【讨论】：

不错的总结。但我想你错过了我最喜欢的方法：使用自定义函数的选项，该函数返回您使用相同函数或另一个（子）函数设置的 static 变量的值。很像 TempVars。 @Gustav 随意编辑它。我将其标记为社区 wiki，因此每个人都可以做出贡献，没有人会获得代表。我没有经常使用这种技术，所以你可能比我更了解细节。不，这对我来说是新的。但我已插入该部分。即使在“纯访问”上下文中，如果您有指向 Oracle 或 SQL Server 的链接表，其中一些方法也会对性能产生巨大的负面影响。更多：对于 Oracle，在使用 Oracle 的 ODBC 驱动程序时，在查询中引用表单字段根本不起作用，而在使用 Microsoft 的 Oracle 驱动程序时可能会起作用。我从未尝试过，但我不这么认为。 Afaik DAO 直通查询按原样传递给服务器，没有参数解析（实际上，在 Access/DAO 端根本没有解析）。考虑改用 ADO。如果你有一个特定的问题，那可能是一个很好的单独问题【参考方案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 子句，并且同名的参数只需声明一次。完整代码在我的github 并在下面转载。我还有一个version 用于使用 ADODB 参数的 Oracle 直通查询。最后，我想将两者都包装在一个 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

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

【讨论】：

这个类并没有解决很多字符串连接的问题。仍然存在的问题是：空值处理不正确、带引号的字符串处理不正确以及使用 dd-mm-yyyy 格式在语言环境中不正确处理日期。此外，如果存在名称重叠的参数，例如使用 Replace 会导致问题。 @a 和 @age。虽然我很欣赏这种努力，但以目前的形式，我更喜欢真正的参数。此外，DAO 支持命名参数。不过，我很欣赏这种努力。您可以在Code Review 上查看此类课程。

以上是关于如何在 Microsoft Access 的不同上下文中使用 VBA 中的参数？的主要内容，如果未能解决你的问题，请参考以下文章

如何在 Access 2016 中的另一列上选择具有最大值的不同行

如何在 Microsoft Access 中透视表？

如何在 Microsoft Access 中通过 VBA 设置 INSERT SQL 查询的参数值？

如何在 microsoft access 查询中格式化日期

如何在 Microsoft Access 表单上计算年龄？ [复制]

如何在 Microsoft Azure windows server 2012 R2 中启用 Microsoft Access Driver (*.mdb, *.accdb)？