query - vba sql select access




Como faço para usar parâmetros no VBA nos diferentes contextos no Microsoft Access? (2)

Eu li muito sobre injeção SQL, e usando parâmetros, de fontes como bobby-tables.com . No entanto, estou trabalhando com um aplicativo complexo no Access, que tem muito SQL dinâmico com concatenação de strings em todos os lugares.

Ele tem as seguintes coisas que eu quero mudar e adicionar parâmetros, para evitar erros e permitir-me lidar com nomes com aspas simples, como Jack O'Connel.

Usa:

  • DoCmd.RunSQL para executar comandos SQL
  • Conjuntos de registros DAO
  • Conjuntos de registros ADODB
  • Formulários e relatórios, abertos com DoCmd.OpenForm e DoCmd.OpenReport , usando concatenação de sequência no argumento WhereCondition
  • Agregados de domínio, como o DLookUp que usam a concatenação de strings

As consultas são principalmente estruturadas assim:

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

Quais são minhas opções para usar parâmetros para esses diferentes tipos de consultas?

Esta questão destina-se como um recurso, para o freqüente como eu uso parâmetros de comentário em vários posts


Eu construí uma classe de construtor de consulta bastante básica para contornar a confusão de concatenação de seqüência de caracteres e para lidar com a falta de parâmetros nomeados. Criar uma consulta é bastante simples.

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

A saída do método ToString () se parece com:

SELECT * FROM tblEmployees ONDE 1 = 1 AND (StartDate> # 3/29/2018 # OU StatusChangeDate> # 3/29/2018 #) E (StatusIndicator IN ('A', 'L') OU Nota> 10) E ( Salário> 9999.99) AND (Retired = False) ORDER BY ID ASC;

Cada predicado é empacotado em parens para manipular cláusulas AND / OR vinculadas, e os parâmetros com o mesmo nome só precisam ser declarados uma vez. O código completo está no meu github e reproduzido abaixo. Eu também tenho uma version para consultas de passagem do Oracle que usa parâmetros ADODB. Eventualmente, gostaria de incluir ambos em uma interface 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

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

Existem muitas maneiras de usar parâmetros em consultas. Vou tentar fornecer exemplos para a maioria deles e onde eles são aplicáveis.

Primeiro, discutiremos as soluções exclusivas do Access, como formulários, relatórios e agregados de domínio. Então, falaremos sobre o DAO e o ADO.

Usando valores de formulários e relatórios como parâmetros

No Access, você pode usar diretamente o valor atual dos controles em formulários e relatórios em seu código SQL. Isso limita a necessidade de parâmetros.

Você pode se referir aos controles da seguinte maneira:

Forms!MyForm!MyTextbox para um controle simples em um formulário

Forms!MyForm!MySubform.Form!MyTextbox para um controle em um subformulário

Reports!MyReport!MyTextbox para um controle em um relatório

Implementação de amostra:

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

Isso está disponível para os seguintes usos:

Ao usar DoCmd.RunSQL , consultas normais (na GUI), fontes de registro de formulário e relatório, filtros de formulário e relatório, agregados de domínio, DoCmd.OpenForm e DoCmd.OpenReport

Isso não está disponível para os seguintes usos:

Ao executar consultas usando DAO ou ADODB (por exemplo, abrindo conjuntos de registros, CurrentDb.Execute )

Usando TempVars como parâmetros

TempVars no Access são variáveis ​​disponíveis globalmente, que podem ser definidas no VBA ou usando macro. Eles podem ser reutilizados para várias consultas.

Implementação de amostra:

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

A disponibilidade para TempVars é idêntica à dos valores de formulários e relatórios: não disponível para ADO e DAO, disponível para outros usos.

Eu recomendo TempVars para usar parâmetros ao abrir formulários ou relatórios sobre referências a nomes de controle, uma vez que se o objeto abrindo for fechado, os TempVars permanecerão disponíveis. Eu recomendo usar nomes TempVar exclusivos para cada formulário ou relatório, para evitar estranheza ao atualizar formulários ou relatórios.

Usando funções personalizadas (UDFs) como parâmetros

Muito parecido com TempVars, você pode usar uma função personalizada e variáveis ​​estáticas para armazenar e recuperar valores.

Implementação de amostra:

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

e depois:

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

Além disso, uma única função com um parâmetro opcional pode ser criada para definir e obter o valor de uma variável estática privada:

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

Para definir um valor:

ThisValue "Some text value"

Para obter o valor:

CurrentValue = ThisValue

Em uma consulta:

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

Usando DoCmd.SetParameter

Os usos de DoCmd.SetParameter são bastante limitados, então serei breve. Ele permite que você defina um parâmetro para uso em DoCmd.OpenForm , DoCmd.OpenReport e algumas outras instruções DoCmd , mas não funciona com DoCmd.RunSQL , filtros, DAO e ADO.

Implementação de amostra

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

Usando o DAO

No DAO, podemos usar o objeto DAO.QueryDef para criar uma consulta, definir parâmetros e abrir um conjunto de registros ou executar a consulta. Primeiro você define o SQL das consultas e, em seguida, usa a coleção QueryDef.Parameters para definir os parâmetros.

No meu exemplo, vou usar tipos de parâmetro implícitos. Se você quiser torná-los explícitos, adicione uma declaração PARAMETERS à sua consulta.

Implementação de amostra

'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

Enquanto isso só está disponível no DAO, você pode definir muitos itens para conjuntos de registros DAO para torná-los usar parâmetros, como conjuntos de registros de formulário, conjuntos de registros de caixa de listagem e conjuntos de registros de caixa de combinação. No entanto, como o Access usa o texto, e não o conjunto de registros, ao classificar e filtrar, essas coisas podem ser problemáticas se você o fizer.

Usando o ADO

Você pode usar parâmetros no ADO usando o objeto ADODB.Command . Use Command.CreateParameter para criar parâmetros e, em seguida, anexe-os à coleção Command.Parameters .

Você pode usar a coleção .Parameters no ADO para declarar explicitamente parâmetros ou passar uma matriz de parâmetro para o método Command.Execute para implicitamente passar parâmetros.

O ADO não suporta parâmetros nomeados. Enquanto você pode passar um nome, ele não é processado.

Implementação de amostra:

'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

As mesmas limitações que a abertura de conjuntos de registros DAO se aplicam. Embora esse caminho esteja limitado a executar consultas e abrir conjuntos de registros, você pode usar esses conjuntos de registros em outro lugar em seu aplicativo.





access-vba