VBA/Excel/Access/Word/Access/SQL Parameter

Build the SQL statement dynamically

 
Sub MyFirstConnection2()
    Dim myConnection As ADODB.Connection
    Dim myRecordset As ADODB.Recordset
    Dim strSQL As String
    Dim strSearch As String
    
    strSearch = "Lee"
    
    strSQL = "SELECT FirstName, LastName FROM Employees" & _
              " WHERE LastName = " & " "" & strSearch & """
    
    Set myConnection = CurrentProject.Connection
    
    Set myRecordset = New ADODB.Recordset
    myRecordset.Open strSQL, myConnection
    
    Do Until myRecordset.EOF
       Debug.Print myRecordset.Fields("FirstName"), _
                   myRecordset.Fields("LastName")
       myRecordset.MoveNext
    Loop
    myRecordset.Close
    myConnection.Close
    Set myConnection = Nothing
    Set myRecordset = Nothing
End Sub

Creat a SQL statement and append parameter as ceriteria

 
Sub FindByPrice2(curPrice As Currency)
    Dim db As Database
    Dim rec As Recordset
    Dim strSQL As String
    Dim strMatches As String
    Dim intCounter As Integer
    strSQL = "SELECT * FROM tblSales WHERE AmountPaid = " & curPrice
    Set db = CurrentDb()
    Set rec = db.OpenRecordset(strSQL, dbOpenSnapshot)
    Do Until rec.EOF
        Debug.Print rec!SalesID
        rec.MoveNext
    Loop
    intCounter = rec.RecordCount
    Debug.Print FormatCurrency(curPrice)
    rec.Close
End Sub

Creating a Parameter Query

 
Sub Create_ParameterQuery()
   Dim cat As ADOX.Catalog
   Dim cmd As ADODB.rumand
   Dim strPath As String
   Dim strSQL As String
   Dim strQryName As String
   On Error GoTo ErrorHandler
   strPath = CurrentProject.Path & "\mydb.mdb"
   strSQL = "Parameters [Type Country Name] Text;" & _
      "SELECT Customers.* FROM Customers WHERE " _
      & "Customers.Country=[Type Country Name];"
   strQryName = "Customers by Country"
   Set cat = New ADOX.Catalog
   cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath
   Set cmd = New ADODB.rumand
   cmd.rumandText = strSQL
   cat.Procedures.Append strQryName, cmd
   Set cmd = Nothing
   Set cat = Nothing
   Exit Sub
ErrorHandler:
   If InStr(Err.Description, "already exists") Then
      cat.Procedures.Delete strQryName
      Resume
   Else
      MsgBox Err.Number & ": " & Err.Description
   End If
End Sub

Executing a SQL Statement Containing Parameters

 
Public Sub UpdateWithSQL()
        Dim cmd As New ADODB.rumand
        Dim conn As ADODB.Connection
        Dim prm As ADODB.Parameter
        Dim strConn As String
        Dim strSQL As String
        strConn = "Provider=SQLOLEDB.1;" & _
            "Data Source=(local); Initial Catalog=NorthWind;" & _
            "Integrated Security=SSPI"
        Set conn = New ADODB.Connection
        conn.Open strConn
        Set cmd = New ADODB.rumand
        cmd.rumandText = "UPDATE Products " & _
            "SET OrderDate = OrderDate, " & _
            "ShipVia = ShipVia, " & _
            "Freight = Freight " & _
            "WHERE OrderID = OrderID"
    cmd.rumandType = adCmdText
    cmd.ActiveConnection = conn
    Set prm = cmd.CreateParameter("OrderID", adInteger, adParamInput)
    cmd.Parameters.Append prm
    cmd.Parameters("OrderID").Value = 1
    Set prm = cmd.CreateParameter("OrderDate", adDate, adParamInput)
    cmd.Parameters.Append prm
    cmd.Parameters("OrderDate").Value = "10/10/2007"
    Set prm = cmd.CreateParameter("ShipVia", adInteger, adParamInput)
    cmd.Parameters.Append prm
    cmd.Parameters("ShipVia").Value = 2
    Set prm = cmd.CreateParameter("Freight", adCurrency, adParamInput)
    cmd.Parameters.Append prm
    cmd.Parameters("Freight").Value = "1.5"
    cmd.Execute
    conn.Close
End Sub

Running Parameter Queries

 
Sub RunParameterQuery(datStart As Date, datEnd As Date)
    Dim cmd As ADODB.rumand
    Dim rst As ADODB.Recordset
    Set cmd = New ADODB.rumand
    cmd.ActiveConnection = CurrentProject.Connection
    cmd.rumandText = "Select * from Employees " & _
        "Where BirthDate Between ? and ?"
    cmd.rumandType = adCmdText
    Set rst = cmd.Execute(Parameters:=Array(datStart, datEnd))
    Do Until rst.EOF
        Debug.Print rst("EmployeeID"), rst("BirthDate")
        rst.MoveNext
    Loop
    rst.Close
    Set rst = Nothing
    Set cmd = Nothing
End Sub

User InputBox to read SQL statement parameter

 
Sub command_parameters()
  Dim conn As New Connection
  Dim rec As New Recordset
  Dim comm As New Command
  Dim ws As Worksheet
  Dim i&, countryname$
  Set ws = ThisWorkbook.Worksheets("command")
  conn.Open "Provider=microsoft.jet.oledb.4.0;" + _
    "Data Source=" + ThisWorkbook.Path + "\nwind.mdb;"
  Set comm.ActiveConnection = conn
  comm.rumandText = "SELECT companyname FROM customers WHERE country = ?"
  countryname = InputBox("Please type in a country name (i.e. "germany").")
  comm.Parameters(0) = countryname
  rec.Open comm
  ws.[a1].CopyFromRecordset rec
  rec.Close: conn.Close
End Sub