troubleshooting Question

Access Create Table in backend

Avatar of Murray Brown
Murray BrownFlag for United Kingdom of Great Britain and Northern Ireland asked on
DatabasesVBA
11 Comments2 Solutions36 ViewsLast Modified:
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_Arms", "RegExpiryDate", "Date")
    Call Add_Column_to_Backend("t_Licence", "DriverExpiry", "Date")
   
End Sub


'==================== Add Backend Column =========================
Sub Add_Column_to_Backend(ByVal 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).Connect
    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(ByVal 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(ByVal 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
ASKER CERTIFIED SOLUTION
Log in to continue reading
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform for $9.99/mo
View membership options
Unlock 2 Answers and 11 Comments.
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
See how we're fighting big data
The Value of Experts Exchange in My Daily IT Life

Experts Exchange (EE) has become my company's go-to resource to get answers. I've used EE to make decisions, solve problems and even save customers. OutagesIO has been a challenging project and... Keep reading >>

Mike

Owner of Outages.IO
Phoenix, Arizona, United States
Member Since 2016
Join a full scale community that combines the best parts of other tools into one platform.
Unlock 2 Answers and 11 Comments.
View membership options
“All of life is about relationships, and EE has made a virtual community a real community. It lifts everyone's boat.”
William Peck

Member since 2004