Hi
In Access I am using the following VBA code to add new columns in a linked table which is in another database.
What similar code would I use to rather create a new linked table?
Thanks
Sub Main
Call Add_Column_to_Backend("t_A
rms", "RegExpiryDate", "Date")
Call Add_Column_to_Backend("t_L
icence", "DriverExpiry", "Date")
End Sub
'==================== Add Backend Column =========================
Sub Add_Column_to_Backend(ByVa
l oTable As String, ByVal oColumn As String, ByVal oType As String)
On Error Resume Next
Dim strDbName As String 'Database name
strDbName = GetLinkedDBName(oTable)
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.field
Dim blnFieldExists As Boolean
''Set dbs = CurrentDb()
Set dbs = OpenDatabase(strDbName)
Set tdf = dbs.TableDefs(oTable)
For Each fld In tdf.Fields
If fld.Name = oColumn Then
blnFieldExists = True
Exit For
End If
Next
''
https://docs.microsoft.com/en-us/office/client-developer/access/desktop-database-reference/tabledef-createfield-method-dao
If Not blnFieldExists Then
If oType = "Date" Then
Set fld = tdf.CreateField(oColumn, dbDate)
fld.DefaultValue = "=Now()"
ElseIf oType = "Text" Then
Set fld = tdf.CreateField(oColumn, dbText)
ElseIf oType = "Integer" Then
Set fld = tdf.CreateField(oColumn, dbInteger)
Else
Set fld = tdf.CreateField(oColumn, dbText)
End If
''
tdf.Fields.Append fld
MsgBox "New column & '" & oColumn & "' added to table '" & oTable & "'"
End If
End Sub
Public Function GetLinkedDBName(TableName As String)
Dim db As DAO.Database, Ret
On Error GoTo DBNameErr
Set db = CurrentDb()
Ret = db.TableDefs(TableName).Co
nnect
GetLinkedDBName = Right(Ret, Len(Ret) - (InStr(1, Ret, "DATABASE=") + 8))
Exit Function
DBNameErr:
GetLinkedDBName = 0
End Function
'==================== Add Backend Column (End) =========================
'+++++++++++++++++++ Rename Backend Column +++++++++++++++++++++++
Public Sub RenameColumn(ByVal TableName As String, ByVal oldName As String, ByVal newName As String)
On Error Resume Next
Dim dbName As String
dbName = GetLinkedDBName(TableName)
Dim db As DAO.Database
Set db = OpenDatabase(dbName)
Dim tdf As DAO.TableDef
Set tdf = db.TableDefs(TableName)
If (ExistInCollection(oldName
, tdf.Fields)) Then
Dim field As DAO.field
Set field = tdf.Fields(oldName)
field.Name = newName
End If
End Sub
Public Function ExistInCollection(ByVal key As String, ByRef col As Object) As Boolean
On Error Resume Next
ExistInCollection = ExistInCollectionByVal(key
, col) Or ExistInCollectionByRef(key
, col)
End Function
Private Function ExistInCollectionByVal(ByV
al key As String, ByRef col As Object) As Boolean
On Error GoTo Error
Dim item As Variant
item = col(key)
ExistInCollectionByVal = True
Exit Function
Error:
ExistInCollectionByVal = False
End Function
Private Function ExistInCollectionByRef(ByV
al key As String, ByRef col As Object) As Boolean
On Error GoTo Error
Dim item As Variant
Set item = col(key)
ExistInCollectionByRef = True
Exit Function
Error:
ExistInCollectionByRef = False
End Function
Open in new window