access tempvars 宏_如何在MicrosoftAccess的不同上下文中使用VBA中的参数？

我构建了一个相当基本的查询生成器类，以避免字符串连接的混乱，并处理缺乏命名参数的问题。创建查询相当简单。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 WithEnd Function

ToString()方法的输出如下所示：从1=1和(StartDate>#3/29/2018#或StatusChangeDate>#3/29/2018#)和(StatusIndicator in(‘A’，‘L’)OR>10)和(工资>9999.99)和(退休=假)ID ASC中选择*；

每个谓词都用Parens包装以处理链接和/OR子句，而同名的参数只需声明一次。完整代码在我的GitHub并转载如下。我也有一个版本对于使用ADODB参数的Oracle传递查询。最后，我想将两者都封装在IQueryBuilder界面中。VERSION 1.0 CLASSBEGIN

MultiUse = -1  'TrueENDAttribute VB_Name = "MSAccessQueryBuilder"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = TrueAttribute VB_PredeclaredId = FalseAttribute VB_Exposed = True'@Folder("VBALibrary.Data")'@Description("Provides tools to construct Microsoft Access SQL statements containing predicates and parameters.")Option ExplicitPrivate Const mlngErrorNumber As Long = vbObjectError + 513Private 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 StringEnd TypePrivate mobjParameters As ObjectPrivate mobjPredicates As CollectionPrivate this As TSqlBuilder' =============================================================================' CONSTRUCTOR / DESTRUCTOR' =============================================================================Private Sub Class_Initialize()

Set mobjParameters = CreateObject("Scripting.Dictionary")

Set mobjPredicates = New CollectionEnd 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.QueryBodyEnd PropertyPublic Property Let QueryBody(ByVal Value As String)

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

QueryFooter = this.QueryFooterEnd PropertyPublic Property Let QueryFooter(ByVal Value As String)

this.QueryFooter = ValueEnd 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 IfEnd 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 IfEnd 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 IfEnd 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 IfEnd 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 IfEnd 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 StringDim 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 IfEnd 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 StringDim lngMatchedPoisition As LongDim 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 IfEnd 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 StringDim strPredicates As StringDim 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 = strPredicatesEnd 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 StringDim vntKey As VariantDim strParameterName As StringDim strParameterValue As StringDim 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 = strPredicatesWithValuesEnd Function' =============================================================================