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
Our community of experts have been thoroughly vetted for their expertise and industry experience.
The Distinguished Expert awards are presented to the top veteran and rookie experts to earn the most points in the top 50 topics.