VBA/Excel/Access/Word/Access/Query

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>