VBA/Excel/Access/Word/Access/Query
Содержание
- 1 Create Query by using the Database.CreateQueryDef
- 2 Creating a Pass-Through Query with ADOX
- 3 Creating a Query Using Code
- 4 Delete a query
- 5 Execuate query
- 6 Executing a Pass-Through Query Saved in Access
- 7 Get the created query name
- 8 Making Bulk Changes
- 9 Pass parameter to a query
- 10 Update a table with QueryDef
- 11 User Defined Property
- 12 Using a Stored Procedure to Make Bulk Changes to Data in a SQL Server Database
- 13 Using CreateParameter to delete a company record
Create Query by using the Database.CreateQueryDef
<source lang="vb">
Sub exaPropertyandMethod()
Dim dbLib As Database Dim qdfExpensive As QueryDef Set dbLib = CurrentDb() Debug.Print dbLib.Name Set qdfExpensive = dbLib.CreateQueryDef("Expensive", "SELECT * FROM BOOKS WHERE Price > 20")
End Sub
</source>
Creating a Pass-Through Query with ADOX
<source lang="vb">
Sub Create_PassThroughQuery()
Dim cat As ADOX.Catalog Dim cmd As ADODB.rumand Dim myRecordset As ADODB.Recordset Dim strPath As String Dim strSQL As String Dim strQryName As String Dim strODBCConnect As String On Error GoTo ErrorHandler strSQL = "SELECT Customers.* FROM Customers WHERE Customers.Country="France";" strQryName = "French Customers" strODBCConnect = "ODBC;Driver=SQL Server;Server=yourserver\yourName;" & _ "Database=Northwind;UID=;PWD=" Set cat = New ADOX.Catalog cat.ActiveConnection = CurrentProject.Connection Set cmd = New ADODB.rumand With cmd .ActiveConnection = cat.ActiveConnection .rumandText = strSQL .Properties("Jet OLEDB:ODBC Pass-Through Statement") = True .Properties("Jet OLEDB:Pass-Through Query Connect String") = _ strODBCConnect End With 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
</source>
Creating a Query Using Code
<source lang="vb">
Sub CreateQuery()
Dim cmd As ADODB.rumand Dim strSQL As String Dim cat As ADOX.Catalog Set cat = New ADOX.Catalog cat.ActiveConnection = CurrentProject.Connection Set cmd = New ADODB.rumand cmd.rumandText = "Select * From Employees Where State="CA"" cat.Views.Append "qryCAClients", cmd cat.Views.Refresh Set cat = Nothing Set cmd = Nothing
End Sub
</source>
Delete a query
<source lang="vb">
Private Sub TimeToCompletionI()
Dim db As Database Set db = CurrentDb Dim qry1 As QueryDef Dim sSQL1 As String On Error Resume Next db.QueryDefs.Delete "temp1" On Error GoTo 0 sSQL1 = "SELECT * from Employees" Set qry1 = db.CreateQueryDef("temp1", sSQL1) DoCmd.OpenQuery qry1.Name
End Sub
</source>
Execuate query
<source lang="vb">
Sub UsingQuery()
Dim conn As ADODB.Connection Dim recs As Long Set conn = CurrentProject.Connection With conn .Execute "qryUpdateCountry", recs, adExecuteNoRecords .Close End With Set conn = Nothing MsgBox recs
End Sub
</source>
Executing a Pass-Through Query Saved in Access
<source lang="vb">
Sub Execute_PassThroughQuery()
Dim cat As ADOX.Catalog Dim cmd As ADODB.rumand Dim myRecordset As ADODB.Recordset Dim strConnect As String strConnect = "Provider=SQLOLEDB;Data Source=yourServer\yourName;" & _ "Initial Catalog=Northwind;User Id=sa;Password=" Set cat = New ADOX.Catalog cat.ActiveConnection = CurrentProject.Connection Set cmd = New ADODB.rumand Set cmd = cat.Procedures("French Customers").rumand Set myRecordset = cmd.Execute Debug.Print myRecordset.GetString Set myRecordset = Nothing Set cmd = Nothing Set cat = Nothing
End Sub
</source>
Get the created query name
<source lang="vb">
Private Sub OverlappingIntervals()
Dim db As Database Set db = CurrentDb Dim qry As QueryDef Dim sSQL As String On Error Resume Next db.QueryDefs.Delete "temp" On Error GoTo 0 sSQL = "SELECT * from Employees" Set qry = db.CreateQueryDef("temp", sSQL) DoCmd.OpenQuery qry.Name
End Sub
</source>
Making Bulk Changes
<source lang="vb">
Sub RunUpdateQuery()
Dim cnn As ADODB.Connection Set cnn = New ADODB.Connection Set cnn = CurrentProject.Connection cnn.Execute "qryIncreaseTotalEstimate" cnn.Close
End Sub
</source>
Pass parameter to a query
<source lang="vb">
Public Sub DeleteCust(lngID As Long)
Dim cmd As ADODB.rumand Set cmd = New ADODB.rumand With cmd .ActiveConnection = CurrentProject.Connection .rumandText = "qryDeleteCompany" .rumandType = adCmdStoredProc .Execute , Parameters:=lngID End With
End Sub
</source>
Update a table with QueryDef
<source lang="vb">
Sub exaCreateAction()
Dim db As Database Dim qdf As QueryDef Dim strSQL As String Set db = CurrentDb strSQL = "UPDATE BOOKS SET Price = Price*1.1 WHERE Price > 20" Set qdf = db.CreateQueryDef("PriceInc", strSQL) qdf.Execute
End Sub
</source>
User Defined Property
<source lang="vb">
Sub exaUserDefinedProperty()
Dim db As Database Dim tbl As TableDef Dim prp As Property Dim str As String Set db = CurrentDb Set tbl = db!BOOKS Set prp = tbl.CreateProperty("UserProperty", dbText, "Programming DAO is fun.") tbl.Properties.Append prp str = "" For Each prp In tbl.Properties Debug.Print prp.Name Debug.Print prp.Value Debug.Print prp.Type Debug.Print prp.Inherited Next prp Debug.Print tbl.Properties.Count
End Sub
</source>
Using a Stored Procedure to Make Bulk Changes to Data in a SQL Server Database
<source lang="vb">
Sub RunUpdateQuery()
Dim cnn As ADODB.Connection Set cnn = New ADODB.Connection "Establish the connection and execute a stored procedure cnn.Open "Provider=SQLOLEDB.1;" & _ "Data Source=(local); Initial Catalog=NorthWind;" & _ "Integrated Security=SSPI" cnn.Execute "procIncreaseTotalEstimate" cnn.Close
End Sub
</source>
Using CreateParameter to delete a company record
<source lang="vb">
Public Sub DeleteCustParam()
Dim cmd As ADODB.rumand Dim prm As ADODB.Parameter Set cmd = New ADODB.rumand With cmd .ActiveConnection = CurrentProject.Connection .rumandText = "qryDeleteCompany" .rumandType = adCmdStoredProc Set prm = cmd.CreateParameter(Name:="MyParam", Type:=adInteger,Direction:=adParamInput).Parameters.Append prm prm.Value = 13 .Execute End With
End Sub
</source>