I have been looking after an MS Access database, using table links to
access data in a back-end MDB database. We have recently micrated to a
SQL Server 2000 back-end atabase, once again accessing it though table links.
I am comfortable with the data side of things (whether through table
links or an adodb.recordset ). What I am missing, however, is all the
useful things you could do to automatically maintain a back-end database
from a front-end database via the DAO 'Database' Object which exposes
the TableDefs Collection, the TableDef Object, the Fields Collection, the
Field, the Indexes Collection and the Index object.
Is there any way I can, from an Access 2000 front-end database, connect
to a SQL Server 2000 database as a 'database' to perform the tasks in the
following procedures.
access data in a back-end MDB database. We have recently micrated to a
SQL Server 2000 back-end atabase, once again accessing it though table links.
I am comfortable with the data side of things (whether through table
links or an adodb.recordset ). What I am missing, however, is all the
useful things you could do to automatically maintain a back-end database
from a front-end database via the DAO 'Database' Object which exposes
the TableDefs Collection, the TableDef Object, the Fields Collection, the
Field, the Indexes Collection and the Index object.
Is there any way I can, from an Access 2000 front-end database, connect
to a SQL Server 2000 database as a 'database' to perform the tasks in the
following procedures.
Code:
Private Sub SetBackEndDatabase(db As Database)
Set db = _
OpenDatabase("w:\backend\backend.mdb", False, False, ";PWD=" & "BackEndDatabasePassword")
End Sub
Private Sub ModifyField(db, udtFieldProperties As FieldProps)
Dim tdf As TableDef, fld As Field
With udtFieldProperties
Set tdf = db.TableDefs(.TableName)
Set fld = tdf.Fields(.FieldName)
If .FieldType = dbText Then
fld.AllowZeroLength = .FieldAllowZeroLength
End If
fld.Required = .FieldRequired
End With
db.TableDefs.Refresh
End Sub
Private Sub CreateIndexInExistingTable(db, udtFieldProperties As FieldProps)
Dim tdf As TableDef
Set tdf = db.TableDefs(udtFieldProperties.TableName)
CreateIndex tdf, udtFieldProperties
End Sub
Private Sub CreateFieldInExistingTable(db, udtFieldProperties As FieldProps)
Dim tdf As TableDef
Set tdf = db.TableDefs(udtFieldProperties.TableName)
CreateField tdf, udtFieldProperties
End Sub
Private Sub RenameField(db As Database, ByVal strTableName As String, ByVal _
strOriginalFieldName As String, ByVal strNewFieldName As String)
Dim tdf As TableDef, fld As Field
Set tdf = db.TableDefs(strTableName)
Set fld = tdf.Fields(strOriginalFieldName)
fld.Name = strNewFieldName
db.TableDefs.Refresh
End Sub
Private Sub RenameIndex(db As Database, ByVal strTableName As String, ByVal _
strOriginalIndexName As String, ByVal strNewIndexName As String)
Dim tdf As TableDef, idx As Index
Set tdf = db.TableDefs(strTableName)
Set idx = tdf.Indexes(strOriginalIndexName)
idx.Name = strNewIndexName
db.TableDefs.Refresh
End Sub
Private Sub RenameTable(db As Database, ByVal strOriginalTableName As String, _
ByVal strNewTableName As String)
Dim tdf As TableDef
Set tdf = db.TableDefs(strOriginalTableName)
tdf.Name = strNewTableName
db.TableDefs.Refresh
End Sub
Private Sub DeleteField(db As Database, ByVal strTableName As String, _
ByVal strFieldName As String)
Dim tdf As TableDef
Const conItemNotFoundInThisCollection = 3265
On Error GoTo XEH
Set tdf = db.TableDefs(strTableName)
tdf.Fields.Delete (strFieldName)
db.TableDefs.Refresh
XEH: If Err = conItemNotFoundInThisCollection Then Exit Sub
End Sub
Private Sub DeleteIndex(db As Database, ByVal strTableName As String, ByVal _
strIndexName As String)
Dim tdf As TableDef
Const conItemNotFoundInThisCollection = 3265
On Error GoTo XEH
Set tdf = db.TableDefs(strTableName)
tdf.Indexes.Delete (strIndexName)
db.TableDefs.Refresh
XEH: If Err = conItemNotFoundInThisCollection Then Exit Sub
End Sub
Private Sub DeleteTable(db As Database, ByVal strTableName As String)
Const conItemNotFoundInThisCollection = 3265
On Error GoTo XEH
db.TableDefs.Delete (strTableName)
db.TableDefs.Refresh
XEH: If Err = conItemNotFoundInThisCollection Then Exit Sub
End Sub
Private Sub CreateTable(db As Database, udtFieldProperties() As FieldProps)
Dim tdf As TableDef, i As Long
Set tdf = db.CreateTableDef(udtFieldProperties(1).TableName)
For i = 1 To UBound(udtFieldProperties)
CreateField tdf, udtFieldProperties(i)
If udtFieldProperties(i).FieldIdx <> "None" Then
CreateIndex tdf, udtFieldProperties(i)
End If
Next i
db.TableDefs.Append tdf
db.TableDefs.Refresh
End Sub
Private Sub CreateField(ByVal tdf As TableDef, udtFieldProperties As FieldProps)
Dim fld As Field
With udtFieldProperties
Set fld = tdf.CreateField(.FieldName, .FieldType, .FieldSize)
If .FieldType = dbText Then
fld.AllowZeroLength = .FieldAllowZeroLength
End If
fld.Required = .FieldRequired
End With
tdf.Fields.Append fld
tdf.Fields.Refresh
End Sub
Private Sub CreateIndex(ByVal tdf As TableDef, udtFieldProperties As FieldProps)
Dim idx As Index, idxfld As Field
With udtFieldProperties
Set idx = tdf.CreateIndex("IDX_" & .FieldName)
Set idxfld = idx.CreateField(.FieldName)
idx.Fields.Append idxfld
If .FieldIdx = "Primary" Then
idx.Primary = True
idx.Required = True
End If
If .FieldIdx = "Primary" Or .FieldIdx = "Unique" Then
idx.Unique = True
End If
tdf.Indexes.Append idx
tdf.Indexes.Refresh
End With
End Sub
Comment