FunctDB

Function CreateDatabase(DatabasePath As String, dbLanguage _
As String, JetVersion As Integer) As Boolean
Dim TempWs As Workspace
Dim TempDB As Database
On Error GoTo Errors:
Set TempWs = DBEngine.Workspaces(0)
Set TempDB = TempWs.CreateDatabase(DatabasePath, _
dbLanguage, JetVersion)
CreateDatabase = True
Exit Function
Errors:
CreateDatabase = False
End Function
'___________________________________________________________


Function CreateTable(DatabasePath As String, NewTableName _
As String) As Boolean
Dim dbsTarget As Database
Dim tdfNew As TableDef
On Error GoTo Errors:
If TableExists(DatabasePath, NewTableName) = False _
Then
'This table does not exist on the target

'database, so it is ok to add it.

Set dbsTarget = OpenDatabase(DatabasePath)
Set tdfNew = _
dbsTarget.CreateTableDef(NewTableName)
With tdfNew
.Fields.Append .CreateField("Temp", dbInteger)
End With
'The new table has been created, append it to the

'database

dbsTarget.TableDefs.Append tdfNew
dbsTarget.TableDefs(NewTableName).Fields. _
Delete ("Temp")
dbsTarget.Close
CreateTable = True
Else
'This table does exist on the target

'database, so do not add it.

End If
Exit Function
Errors:
CreateTable = False
End Function

Function CreateField(DatabasePath As String, _
TargetTableName As String, NewFieldName As String, _
FieldDataType As Integer) As Boolean
Dim dbsTarget As Database
Dim tdfTarget As TableDef
On Error GoTo Errors:
CreateField = False
Set dbsTarget = OpenDatabase(DatabasePath)
If TableExists(DatabasePath, TargetTableName) Then
'The table exists, assign the table to the

'tabledef and proceed.

Set tdfTarget = _
dbsTarget.TableDefs(TargetTableName)
If Not FieldExists(DatabasePath, _
TargetTableName, NewFieldName) Then
'The Field doesn't exist, so create it.

With tdfTarget
.Fields.Append _
.CreateField(NewFieldName, _
FieldDataType)
End With
CreateField = True
Else
'Field exists, we cannot create it.

End If
Else
'The table does not exist, so we cannot add a new

'field to it.

End If
Exit Function
Errors:
CreateField = False
End Function
'___________________________________________________________


Function TableExists(DatabasePath As String, TableName As _
String) As Boolean
Dim dbsSource As Database
Dim tdfCheck As TableDef
On Error GoTo Errors:
TableExists = False
Set dbsSource = OpenDatabase(DatabasePath)
With dbsSource
' Enumerate TableDefs collection.

For Each tdfCheck In .TableDefs
If tdfCheck.Name = TableName Then
TableExists = True
Exit For
Else
End If
Next tdfCheck
End With
Exit Function
Errors:
TableExists = False
End Function
'___________________________________________________________


Function FieldExists(DatabasePath As String, TableName As _
String, FieldName As String) As Boolean
Dim dbsSource As Database
Dim tdfSource As TableDef
Dim fldCheck As Field
On Error GoTo Errors:
FieldExists = False
If TableExists(DatabasePath, TableName) Then
Set dbsSource = OpenDatabase(DatabasePath)
Set tdfSource = dbsSource.TableDefs(TableName)
With tdfSource
' Enumerate TableDefs collection.

For Each fldCheck In .Fields
If fldCheck.Name = FieldName Then
FieldExists = True
Exit For
End If
Next fldCheck
End With
Else
'The Table doesn't exist, so neither

'can the field.

FieldExists = False
End If
Exit Function
Errors:
FieldExists = False
End Function

'If you do frequent lookups, it's more productive to open and close your database

'externally to the functions. Because this code opens and closes the database

'each time, it's not meant for intensive or constant calling.