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

Материал из VB Эксперт

Перейти к: навигация, поиск


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"), _
    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
    intCounter = rec.RecordCount
    Debug.Print FormatCurrency(curPrice)
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
   If InStr(Err.Description, "already exists") Then
      cat.Procedures.Delete strQryName
      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"
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")
    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