These several database functions work together and perform various utility functions, such as checking if fields and tables exist, creating fields and tables, and so on. The interface hides all the code and returns True or False to report the status of the functions:
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 FunctionErrors: CreateDatabase = FalseEnd FunctionFunction 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 FunctionErrors: CreateTable = FalseEnd FunctionFunction 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 FunctionErrors: CreateField = FalseEnd FunctionFunction 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 FunctionErrors: TableExists = FalseEnd FunctionFunction 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 FunctionErrors: FieldExists = FalseEnd FunctionIf 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.
