• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• AdoxData.cls

AdoxData.cls

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

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".

Rate AdoxData.cls

• 1
• 2
• 3
• 4
• 5

(5(5 Vote))

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
'* [email protected]
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