Manipulating Tables with DAO/ADOX / SQL
This small project allows you to rename a table, add a new table, delete a table, or insert an entire table from one database into another.
The project when first run creates two simple databases "Database1" and "Database2", both with five fields, and displays the tables in two listboxes. You can then select a table from either list and delete,rename or copy it to the other database. You are given the choice of using either DAO or ADOX code for all operations, as the project uses references to DAO v3.6, ADO v2.7 and ADOX v2.5. All libraries can co-exist in one project as long as variables are Dimensioned for the correct type, e.g. Dim rs As DAO.Recordset or Dim rs As ADODB.Recordset.
You can download it Here
The project starts with a simple choice:
The code to select the chosen library is to simply set a property on the main form, which sets a Form-level boolean variable used throughout the rest of the project:
Private Sub cmdADO_Click()
frmTableManipulation.IsDAO = False
frmTableManipulation.Show
Unload Me
End Sub
Private Sub cmdDAO_Click()
frmTableManipulation.IsDAO = True
frmTableManipulation.Show
Unload Me
End Sub
Option Explicit
Dim fDAO As Boolean
Dim db1 As DAO.Database
Dim db2 As DAO.Database
Dim cnn1 As ADODB.Connection
Dim cnn2 As ADODB.Connection
Dim cat1 As ADOX.Catalog
Dim cat2 As ADOX.Catalog
The code to open / create the databases is run on the Form_Load () event:
Private Sub Form_Load()
Dim tdef As DAO.TableDef
Dim Fd As DAO.Field
Dim iX As DAO.Index
Dim tbl As ADOX.Table
Dim col As ADOX.Column
Dim idx As ADOX.Index
Dim iCount As Integer
Dim iFieldCount As Integer
'Move to centre screen
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
'Open or create the databases
If Dir$(App.Path & "\Database1.mdb") <> "" Then
'database already present so open it
If fDAO Then
Set db1 = OpenDatabase(App.Path & "\Database1.mdb")
Else
Set cnn1 = New ADODB.Connection
cnn1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Database1.mdb;Persist Security Info=False"
cnn1.Open
Set cat1 = New ADOX.Catalog
cat1.ActiveConnection = cnn1
End If
Else
'Create new database
If fDAO Then 'use DAO code
Set db1 = CreateDatabase(App.Path & "\Database1.mdb", dbLangGeneral)
For iCount = 1 To 5
'create table1 to table5
Set tdef = db1.CreateTableDef("db1Table" & iCount)
For iFieldCount = 1 To 5
'create fields
Set Fd = tdef.CreateField("Field" & iFieldCount, dbText, 50)
Fd.AllowZeroLength = True
tdef.Fields.Append Fd
Next iFieldCount
'create index
Set iX = tdef.CreateIndex("Index1")
iX.IgnoreNulls = False
iX.Primary = True
iX.Required = True
iX.Unique = True
'Define Index field(s)
Set Fd = iX.CreateField("Field1")
iX.Fields.Append Fd
'append index
tdef.Indexes.Append iX
db1.TableDefs.Append tdef
Next iCount
Else 'Use ADOX code
Set cat1 = New ADOX.Catalog
cat1.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Database1.mdb"
For iCount = 1 To 5
Set tbl = New ADOX.Table
tbl.Name = "db1Table" & iCount
' Add new Table to the Tables collection of the database.
cat1.Tables.Append tbl
With tbl
' Create fields and append them to the
' Columns collection of the new Table object.
For iFieldCount = 1 To 5
Set col = New ADOX.Column
With col
.Name = "Field" & iFieldCount
.DefinedSize = 50
.Type = adVarWChar
.SortOrder = adSortAscending
End With
.Columns.Append col
Set col = Nothing
tbl.Columns("Field" & iFieldCount).Properties("Jet OLEDB:Allow Zero Length") = True
Next iFieldCount
Set idx = New ADOX.Index
With idx
.PrimaryKey = True
.Unique = True
.IndexNulls = adIndexNullsDisallow
.Name = "Index1"
.Columns.Append "Field1"
End With
.Indexes.Append idx
End With
Next iCount
Set cat1 = Nothing
Set cnn1 = New ADODB.Connection
cnn1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Database1.mdb;Persist Security Info=False"
cnn1.Open
Set cat1 = New ADOX.Catalog
cat1.ActiveConnection = cnn1
End If
End If
If Dir$(App.Path & "\Database2.mdb") <> "" Then
'database already present so open it
If fDAO Then
Set db2 = OpenDatabase(App.Path & "\Database2.mdb")
Else
Set cnn2 = New ADODB.Connection
cnn2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Database2.mdb;Persist Security Info=False"
cnn2.Open
Set cat2 = New ADOX.Catalog
cat2.ActiveConnection = cnn2
End If
Else 'not present so create it
If fDAO Then 'Use DAO code
Set db2 = CreateDatabase(App.Path & "\Database2.mdb", dbLangGeneral)
For iCount = 1 To 5
'create table1
Set tdef = db2.CreateTableDef("db2Table" & iCount)
For iFieldCount = 1 To 5
'create fields
Set Fd = tdef.CreateField("Field" & iFieldCount, dbText, 50)
Fd.AllowZeroLength = True
tdef.Fields.Append Fd
Next iFieldCount
'create index
Set iX = tdef.CreateIndex("Index1")
iX.IgnoreNulls = False
iX.Primary = True
iX.Required = True
iX.Unique = True
'Define Index field(s)
Set Fd = iX.CreateField("Field1")
iX.Fields.Append Fd
'append index
tdef.Indexes.Append iX
db2.TableDefs.Append tdef
Next iCount
Else 'Use ADOX code
Set cat2 = New ADOX.Catalog
cat2.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Database2.mdb"
For iCount = 1 To 5
Set tbl = New ADOX.Table
tbl.Name = "db2Table" & iCount
' Add new Table to the Tables collection of the database.
cat2.Tables.Append tbl
With tbl
' Create fields and append them to the
' Columns collection of the new Table object.
For iFieldCount = 1 To 5
Set col = New ADOX.Column
With col
.Name = "Field" & iFieldCount
.DefinedSize = 50
.Type = adVarWChar
.SortOrder = adSortAscending
End With
.Columns.Append col
Set col = Nothing
tbl.Columns("Field" & iFieldCount).Properties("Jet OLEDB:Allow Zero Length") = True
Next iFieldCount
Set idx = New ADOX.Index
With idx
.PrimaryKey = True
.Unique = True
.IndexNulls = adIndexNullsDisallow
.Name = "Index1"
.Columns.Append "Field1"
End With
.Indexes.Append idx
End With
Next iCount
Set cat2 = Nothing
Set cnn2 = New ADODB.Connection
cnn2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Database2.mdb;Persist Security Info=False"
cnn2.Open
Set cat2 = New ADOX.Catalog
cat2.ActiveConnection = cnn2
End If
End If
'now create the lists of tables
RefreshLists
End Sub