Microsoft Access: SQL Programming Code Examples
| Functions |
Description |
| Create_Table() | To create a table using SQL statement if a table name was not already created. |
| CreateMultipleTables(args...) | To automate creation of multiple tables and columns instantaneously. |
| AddDeleteFields() | To add and delete fields using SQL. |
| CreateView() | To create a View with an Inner Join query. |
| NestedQuery() | To create an Inner Join query between 3 tables. |
| CrosstabQuery() | To create a table with a crosstab outer join with another table. |
| Subquery_update() | To update records through a nested subquery. |
| Subquery_deleteDuplicates() | To delete duplicate records. |
Option Compare Database
'
Purpose: To pass table name 'tblStockingList' to the function. If 'tblStockingList'
doesn't exist, it creates the table and columns
Sub Create_Table()
If DoesTableExist("tblStockingList") = False Then
Dim cn As ADODB.Connection
Dim strSQL As String
Set cn = CurrentProject.Connection
strSQL = "CREATE
TABLE tblStockingList (" & _
"[SN]
AutoIncrement PRIMARY KEY, " & _
"[Part_Number]
Text (12), " & _
"[Part_Description]
Text (30), " & _
"[Std_Cost]
Real, " & _
"[Date_Released]
DateTime);"
cn.Execute strSQL
Else
MsgBox "'tblStockingList' table already exists"
End If
cn.Close
Set cn = Nothing
End Sub
' Purpose: To check if a
table already exist.
Function
DoesTableExist(table_name As String) As Boolean
Dim db As Database
Dim tbl As TableDef
Set db = CurrentDb()
DoesTableExist = False
For Each tbl In db.TableDefs
If tbl.Name = table_name Then
DoesTableExist = True
Next tbl
End Function
'a Purpose: Automating multiple tables and column creation instantaneously.
Sub CreateMultipleTables(Table As String, F1 As String,
F2 As String, F3 As String, F4 As String)
Dim cn As ADODB.Connection
Dim strSQL As String
Set cn = CurrentProject.Connection
strSQL = "
& "[" & F2 & "] Text (20), " & "[" & F3 & "] DateTime, " & "[" & F4 & "] Integer)"
cn.Execute strSQL
cn.Close
Set cn = Nothing
End Sub
Sub create_multple_tables()
On Error Resume Next
CreateMultipleTables "UMC_List", "SN", "UMC_PartNumber", "RequestedDate", "Final_Qty"
CreateMultipleTables "SSMC_List", "SN", "SSMC_PartNumber", "SubmittedDate", "Min_Qty"
End Sub
' Purpose: To add and delete fields using SQL
Sub AddDeleteFields()
Dim cn As ADODB.Connection
Dim strSQL As String
Set cn = CurrentProject.Connection
strSQL = "CREATE
TABLE SSMC_List ([SN]
AutoIncrement PRIMARY KEY)"
cn.Execute strSQL
strSQL = "CREATE
TABLE UMC_List ([SN]
AutoIncrement PRIMARY KEY)"
cn.Execute strSQL
strSQL = "ALTER TABLE SSMC_List
ADD COLUMN Request_Reason
TEXT(100)"
cn.Execute strSQL
strSQL = "ALTER TABLE UMC_List
ADD COLUMN PartNumbers_Add
TEXT(15)"
cn.Execute strSQL
strSQL = "ALTER TABLE UMC_List
ALTER COLUMN PartNumbers_Add
Integer"
cn.Execute strSQL
strSQL = "ALTER TABLE SSMC_List
DROP COLUMN Request_Reason"
cn.Execute strSQL
cn.Close
Set cn = Nothing
End Sub
' Purpose: To create a View with an Inner Join query
' This example create an Inner Join query with another table.
It pivots 3 rows heading: 'PartNumber' from main table, CustomerName'
' from the 2nd table, and a new field name as
'Q4_RealizableAmount' which will have values to be computed from two tables,
i.e. [MaterialList.QtyOnhand] x [CustomerList.ListPrice].
The matching part numbers and customer names have to meet the WHERE
' clause criteria which specifies that the available qty
on-hand must be at least more than 1 piece, before the matching data are to
' be retrieved to the main table. The table on the right in the
diagram is the
result data. Download this
database.
Sub CreateView()
Dim cn As ADODB.Connection
Dim strSQL As String
Set cn = CurrentProject.Connection
strSql = "CREATE VIEW qry_CustomerSales AS "
strSql = strSql & "SELECT m.PartNumber, c.CustomerName, "
strSql = strSql & "Format([m.QtyOnHand]*[c.ListPrice],""$#,##0.00"") AS Q4_realizableAmount "
strSql = strSql & "FROM MaterialList AS m INNER JOIN CustomerList AS c ON "
strSql = strSql & "m.PartNumber = c.PartNumber "
strSql = strSql & "WHERE (([m.QtyOnHand]>1));"
cn.Execute strSQL
cn.Close
Set cn = Nothing
End Sub
' Purpose: Using Inner Join to create a nested query between 3 tables, populating queried data to a created table name.
' The main query will only get the data retrieved base on 3 conditions,
that's - if the delivery dates from the 2nd subselect was in
' year 2006; if the sales amount in 2006 was greater than $1000 or is a null
value for each of the matching parts; and if the
' inventory on-hand dollars for each matching part is greater than $300.
The table on the right in the
diagram
is the result data. Download this database
to see.
Sub NestedQuery()
strSql = "SELECT MaterialList.PartNumber, DatePart('yyyy',[DeliveryDate]) AS YrDel, " & _
"Format(CLng(([DeliveredQty]*[ListPrice])),""$#,##0.00"") AS [Sales$], " & _
"Format(Nz(([QtyOnHand]),0)*Nz(([StandardCost]),0),""Currency"") AS [Inventory$], " & _
"CustomerCode.CustomerID, CustomerList.CustomerName " & _
"INTO tbl_StockOnHandDollars " & _
"FROM CustomerCode INNER JOIN (MaterialList INNER JOIN CustomerList " & _
"ON (MaterialList.PartNumber = CustomerList.PartNumber) AND (MaterialList.ID = CustomerList.ID)) " & _
"ON CustomerCode.CustomerName = CustomerList.CustomerName " & _
"WHERE (((DatePart('yyyy',[DeliveryDate]))=2006) " & _
"AND ((Format(CLng(([DeliveredQty]*[ListPrice])),""$#,##0.00"")) >1000 " & _
"OR (Format(CLng(([DeliveredQty]*[ListPrice])),""$#,##0.00"")) Is Null) " & _
"AND ((Format(Nz(([QtyOnHand]),0)*Nz(([StandardCost]),0),""Currency""))>300)) " & _
"ORDER BY MaterialList.PartNumber DESC;"
DoCmd.RunSQL strSql
MsgBox "query has updated table 'tbl_StockOnHandDollars'"
End Sub
' Purpose: To create a Crosstab Query with an Outer Left Join query.
' To create this query, first open a new query, then switch to SQL View,
paste from the code below, save a query name.
' This query creates a View table with
two row heading fields - 'PartNumber' from
main table, and 'CustomerNames' from the other.
' Customer's PO's 'DeliveryDates' are pivoted as column headings,
formatted in
year. The inventory values are the result of
[StandardCost] x [QtyOnHand] from the main table, but where only customer's PO
delivery dates had occurred after 2003 (from the 2nd table). The table on the right in the
diagram
is the result data. Download this database.
SELECT m.PartNumber, c.CustomerName
FROM MaterialList AS m LEFT JOIN CustomerList AS c
ON (m.ID = c.ID) AND (m.PartNumber = c.PartNumber)
WHERE (((DatePart('yyyy',[DeliveryDate]))>2003))
GROUP BY m.PartNumber, c.CustomerName
ORDER BY m.PartNumber DESC
PIVOT DatePart('yyyy',[DeliveryDate]);
' If you want to show
null values
(blank in the column) instead of
zeros, remove the Nz(), like this:
TRANSFORM Sum([StandardCost]*[QtyOnHand]) AS [Inventory$]
' Purpose: to update records through a subquery.
' After you had run the SQL query, check on the SafetyStock field in the main table, you will find that a part for Sony had been updated in its safety stock level from 15 to 17. Download this database.
Sub subquery_update()
DoCmd.RunSQL ("UPDATE MaterialList SET [SafetyStock] = ROUND(([SafetyStock]*1.15),0) " & _
"WHERE PartNumber IN (SELECT PartNumber FROM CustomerList " & _
"WHERE CustomerList.CustomerName = 'Sony' AND CustomerList.DeliveryDate >#12/15/2005#);")
Msgbox "the safety stock level has the quantities already updated."
End Sub
' Purpose: using a subquery to remove duplicate records within a table. 'Duplicates' here mean those part numbers and standard costs both have the same values repeating more than once. Same null values repeating are also duplicates. For the duplicates, the records that have the
lowest primary key value (field ID) will be retained. You need to provide table aliases in order to join a table to itself.Download this database.
Sub s
ubquery_deleteDuplicates()DoCmd.RunSQL ("
DELETE FROM Table1 WHERE ID <>(SELECT Min(ID) AS MinOFiD " & _"FROM Table1 AS dupTable1 WHERE (dupTable1.PartNumber = Table1.PartNumber) " & _
"OR (dupTable1.PartNumber Is Null AND Table1.PartNumber Is Null) " & _
"AND (dupTable1.StandardCost = Table1.StandardCost) " & _
"OR (dupTable1.StandardCost Is Null AND Table1.StandardCost Is Null));")
MsgBox "done! less than 24 records now."
End Sub
