VB icon

AdoxData.cls

Email
Submitted on: 1/3/2015 4:44:00 AM
By: Timothy Vanover (from psc cd)  
Level: Not Given
User Rating: By 4 Users
Compatibility: VB 5.0, VB 6.0
Views: 682
 
     This demonstrates how to create a database and components at runtime from a public sub called from the AdoxData class with ADOX 2.1 objects
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: AdoxData.cls
' Description:This demonstrates how to create a database and components at runtime from a public sub called from the AdoxData class with ADOX 2.1 objects
' By: Timothy Vanover (from psc cd)
'
' Inputs:Call the sub and send it the a string for the database name, and a string for the key table name and one for the detail table name. This will create two tables, with various data types, with a One to many relationship, which will enforce referential integrety.
'
' Assumes:Make sure to set a project reference to "Ext.2.1 for DDL and Security". Updates can be obtained from Microsoft through "Mdac_typ".
'**************************************

Option Explicit
'* This uses ADOX components to create a database and database 
'* objects at runtime. This can be used also to create databases
'* for applications instead of an the actual Microsoft Access 
'* application. Set a reference to "Ext.2.1 for DDL and Security" 
'* in the project references. Add this class to a project and call
'* CreateAdox passing the Database Name, Table Name, Table Name
'* Submitted by Timothy A. Vanover
'* hdhunter@home.com
Private tbl As ADOX.Table
Private cat As ADOX.Catalog 'the actual database
Private idx As ADOX.Index
Private Pkey As ADOX.Key
Public Sub CreateAdox(strCatalogName As String, _
strTableNameOne As String, _
strTableNameTwo As String)
 Set cat = New ADOX.Catalog
 
 On Error GoTo MyError
 
'* This creates the actual database.
 cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
 App.Path & "\" & strCatalogName & ".mdb"
 
 Set tbl = New ADOX.Table
 
 With tbl
 .Name = strTableNameOne
 Set .ParentCatalog = cat
 .Columns.Append "MyPrimaryKey", adInteger 'long data type
 .Columns("MyPrimaryKey").Properties("AutoIncrement") = True 'auto number
 .Columns.Append "MyIntegerData", adSmallInt 'Integer data type
 .Columns.Append "MyStringData", adVarWChar, 25 'string size of 25
 End With
 cat.Tables.Append tbl 'add the table to the database
 
 Set Pkey = New ADOX.Key 'create new key object
 With Pkey
 .Name = "MyPrimaryKey"
 .Type = adKeyPrimary
 .Columns.Append "MyPrimaryKey"
 End With
 tbl.Keys.Append Pkey
 Set Pkey = Nothing
 Set idx = New ADOX.Index
 With idx
 .Unique = False 'duplicates allowed
 .Name = "MyIntegerData"
 .Columns.Append "MyIntegerData"
 End With
 tbl.Indexes.Append idx
 Set idx = Nothing
 
 Set idx = New ADOX.Index
 With idx
 .Unique = True 'NO duplicates allowed
 .Name = "MyStringData"
 .Columns.Append "MyStringData"
 End With
 tbl.Indexes.Append idx
 Set idx = Nothing
 Set tbl = Nothing
 
'* Create a detail Table with a memo Field, and foreign key
 Set tbl = New ADOX.Table
 With tbl
 .Name = strTableNameTwo
 Set .ParentCatalog = cat
 .Columns.Append "MyPrimaryKey", adInteger 'Long data type
 .Columns.Append "MyMemoData", adLongVarWChar 'Memo data type
 End With
 cat.Tables.Append tbl
 
 Set Pkey = New ADOX.Key
 With Pkey 'set relationship
 .Name = "MyPrimaryKey"
 .Type = adKeyForeign
 .RelatedTable = strTableNameOne
 .Columns.Append "MyPrimaryKey"
 .Columns("MyPrimaryKey").RelatedColumn = "MyPrimaryKey"
 .UpdateRule = adRICascade 'Enforce Referential Integrity
 End With
 tbl.Keys.Append Pkey
 
 Set tbl = Nothing
 Set Pkey = Nothing
 Set cat = Nothing
 
 Exit Sub
 
MyError:
 Debug.Print Err.Number & Space$(1) & Err.Description
End Sub


Other 1 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Not Given category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.