VBA/Excel/Access/Word/Access/Query — различия между версиями
Admin (обсуждение | вклад) м (1 версия) |
|
(нет различий)
|
Текущая версия на 12:46, 26 мая 2010
Содержание
- 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
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
Creating a Pass-Through Query with ADOX
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
Creating a Query Using Code
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
Delete a query
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
Execuate query
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
Executing a Pass-Through Query Saved in Access
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
Get the created query name
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
Making Bulk Changes
Sub RunUpdateQuery()
Dim cnn As ADODB.Connection
Set cnn = New ADODB.Connection
Set cnn = CurrentProject.Connection
cnn.Execute "qryIncreaseTotalEstimate"
cnn.Close
End Sub
Pass parameter to a query
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
Update a table with QueryDef
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
User Defined Property
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
Using a Stored Procedure to Make Bulk Changes to Data in a SQL Server Database
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
Using CreateParameter to delete a company record
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