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

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

#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中的TempVars是全局可用的变量，可以在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
 

，然后：

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

此外，还可以创建带有可选参数的单个函数来设置和获取私有静态变量的值：

 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

您可以通过使用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记录集的限制相同。尽管这种方法仅限于执行查询和打开记录集，但是您可以在应用程序中的其他位置使用这些记录集。

#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上，并在下面转载。我也有一个使用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

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