ACC2000: How to Create a Jet CHECK Constraint

Sub CreateJetConstraint()
Dim ADOConnection As New ADODB.Connection
Dim SQL As String
Dim ADOXCat As New ADOX.Catalog
 
On Error GoTo ErrorHandler

'Delete the sample database JetContraint is it already exists.    
Kill "c:\JetContstraint.mdb"

' Using ADOX create a new Jet database.
ADOXCat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data " & _
 "Source=c:\JetContstraint.mdb"
 
' Set the ADO Connection Properties and open the database.
  With ADOConnection
     .Provider = "Microsoft.Jet.OLEDB.4.0"
     .Open "Data Source=c:\JetContstraint.mdb"

' Create a new table called CreditLimit.
     .Execute "CREATE TABLE CreditLimit (CreditLimit DOUBLE);"
     .Execute "INSERT INTO CreditLimit VALUES (100);"
  End With
 
 ' Create a new table called Customer with a check constraint which 
 ' validates that a new customers Credit Limit does not exceed the 
 ' credit limit in the CreditLimit table.

 SQL = "CREATE TABLE Customers (CustId IDENTITY (100, 10), "  
 SQL = SQL & _
  "CFrstNm VARCHAR(10), CLstNm VARCHAR(15), CustomerLimit DOUBLE, "
 SQL = SQL & "CHECK (CustomerLimit <= " & _
  "(SELECT SUM (CreditLimit) FROM CreditLimit)));"

 ADOConnection.Execute SQL
 
 ' Add a new record that does not violate the Customers 
 ' check constraint.
 SQL = "INSERT INTO Customers (CLstNm, CFrstNm, CustomerLimit) VALUES "
 SQL = SQL & "('Smith', 'John', 100);"
 ADOConnection.Execute SQL

 ' Try to add a second record that violates the Customers check 
 ' constraint and results in an error.
 SQL = "INSERT INTO Customers (CLstNm, CFrstNm, CustomerLimit) VALUES "
 SQL = SQL & "('Jones', 'Bob', 200);"
 ADOConnection.Execute SQL
 
 Exit Sub
 
 ErrorHandler:

'Trap for File not found error.
 If Err = 53 Then
     Resume Next
 End If

 MsgBox Error & " Error# " & Err
 Resume Next
 End Sub
					

CreateJetConstraint