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 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/False to report the status of the functions |