Как использовать параметры в VBA в разных контекстах Microsoft Access?
Я много читал о внедрении SQL и использовании параметров из таких источников, как bobby-tables.com. Тем не менее, я работаю со сложным приложением в Access, которое имеет много динамического SQL с конкатенацией строк во всех видах мест.
В нем есть следующие вещи, которые я хочу изменить и добавить параметры, чтобы избежать ошибок и позволить мне обрабатывать имена в одинарных кавычках, например, Джек О'Коннел.
Оно использует:
-
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
Каковы мои варианты использования параметров для этих различных типов запросов?
Этот вопрос предназначен в качестве ресурса, для частых, как я могу использовать параметры комментария к различным постам
Ответы
Ответ 1
Есть много способов использовать параметры в запросах. Я постараюсь предоставить примеры для большинства из них, и где они применимы.
Сначала мы обсудим решения, уникальные для Access, такие как формы, отчеты и совокупности доменов. Затем поговорим о DAO и ADO.
Использование значений из форм и отчетов в качестве параметров
В Access вы можете напрямую использовать текущее значение элементов управления в формах и отчетах в своем коде SQL. Это ограничивает потребность в параметрах.
Вы можете обратиться к элементам управления следующим образом:
Forms!MyForm!MyTextbox
для простого управления формой
Forms!MyForm!MySubform.Form!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
обычные запросы (в графическом интерфейсе), источники записей для форм и отчетов, фильтры форм и отчетов, агрегаты доменов, DoCmd.OpenForm
и DoCmd.OpenReport
Это недоступно для следующих целей:
При выполнении запросов с использованием DAO или ADODB (например, открытие CurrentDb.Execute
записей, CurrentDb.Execute
)
Использование TempVars в качестве параметров
TempVars в Access - это глобально доступные переменные, которые можно установить в 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()"
Также может быть создана отдельная функция с необязательным параметром для установки и получения значения закрытой статической переменной:
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
.
Вы можете использовать коллекцию .Parameters
в ADO для явного объявления параметров или передать массив параметров в метод 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", [email protected]
.AddDateParameter "StartDate", #3/29/2018#
.QueryFooter = "ORDER BY ID ASC"
GetQuery = .ToString
End With
End Function
Результат метода ToString() выглядит так:
SELECT * FROM tblEmployees ГДЕ 1 = 1 И (StartDate > # 3/29/2018 # ИЛИ StatusChangeDate > # 3/29/2018 #) И (StatusIndicator IN ('A', 'L') ИЛИ Grade > 10 ) И (Зарплатa > 9999.99) И (Пенсионный = Неверно) ЗАКАЗАТЬ ПО ID ASC;
Каждый предикат обернут в parens для обработки связанных предложений AND/OR, а параметры с тем же именем должны быть объявлены один раз. Полный код находится на моем github и воспроизведен ниже. У меня также есть версия для запросов Passthrough Oracle, в которых используются параметры ADODB. В конце концов, я хотел бы обернуть оба в интерфейсе 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 name.")
'@Param("blnValue: The parameter 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 name.")
'@Param("curValue: The parameter 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 name.")
'@Param("dtmValue: The parameter 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 name.")
'@Param("lngValue: The parameter 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 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 name.")
'@Param("strValue: The parameter 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 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
' =============================================================================