в 16:33, 26 мая 2010

2010-05-26T16:33:00Z

Admin: 1 версия

2010-05-26T12:46:57Z

1 версия

Новая страница

==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>

← Предыдущая	Версия 16:33, 26 мая 2010
(нет различий)

VBA/Excel/Access/Word/Access/Query - История изменений

в 16:33, 26 мая 2010

Admin: 1 версия