Manage Remote Backend MS Access Database Programmatically With VB Code

How to change tables, fields, indexes after splitting your Access database



If your Microsoft Access database is split into front end and back end, how can you easily modify, or programmatically change, the table structure on the back end? You could manually open the backend database and make the changes. But that is not convenient. What if you're off site? Do you ask the users to email the backend database to you? What if the split database resides on multiple laptop computers? The problem compounds. The solution? By using VBA code on the front end, you can remotely alter tables, fields, and indexes on the back end.

After splitting your Access database into code and data, these functions, and sample code to call them, will help you manage your remote database efficiently. They make it easy to modify field properties, move tables to and from your remote database, link and relink tables, and create indexes. Either copy and paste the visual basic code you need, or get the free download containing all the VBA functions.

Here are some tips and ideas on executing these functions. You can call them from the Autoexec macro or from the Form_Open event of the switchboard or main menu. If it's not convenient to call these functions from your front end database, then you can create a smaller Access database to use exclusively for this purpose. The caveat is that you cannot alter a table that is the recordsource of an open form, because that form locks the table.

How do you execute these functions just once? These functions are designed to safely execute more than once without harm. But just to make sure, and also to save execution time, you can check for certain conditions before calling the functions. For example, you can check the field name, field type, or field size. Also, you can wrap the code inside date criteria.

Note that these functions often refer to MSysObjects, an MS Access built-in system table. In Tools - Options, you can show system objects, making them visible in the database window. Or you can create a query like "SELECT * FROM MSysObjects" in order to see all the revealing information in that table.

The free download is a text file with a ".bas" extension. Just import it as a new module into your Access database. Or you can change the extension to ".txt" if you want to view it in NotePad or other text editor.


Cool Tools for Access

Effortless results in record time! Automate tedious programming tasks (forms, queries, reports). View screen prints.

Manage Remote Database

This wizard makes it easy to modify tables, fields, and indexes on your remote backend database, without even opening the database. View screen prints.

Image File Utility

Browse image files using MS Access image control, search by title or by description, copy to other folders. View screen prints.

Alternative Security Tool

Intuitive security wizard makes it easier to move users to and from groups. View screen prints.

About the Author
Allen Beechick is a Microsoft Access consultant. Do you need a productive consultant for your project? Send your specs and receive a free bid.

Add Field To Table

The function AddFieldToTable works both if the table is linked or local, because the code checks what kind of table it is. The subroutine CallAddField has sample code to call the function. To execute the subroutine, place your cursor inside it, and press F5. 


Function AddFieldToTable(ByVal TblName As String, FldName As String, FldType As Integer, Optional FldPos As Integer,  _
                         Optional FldSize, Optional DefaultValue, Optional FldDes, Optional IsAutoNumber) As Boolean
Dim Db As Database
Dim DbPath As Variant
Dim Td As TableDef
Dim Fd As Field
Dim p As Property

On Error Resume Next

'get back end path of linked table 
    DbPath = DLookup("Database", "MSysObjects", "Name='" & TblName & "' And Type=6")
    If IsNull(DbPath) Then
        Set Db = CurrentDb 'if local table
    Else
        Set Db = OpenDatabase(DbPath) 'if linked table
        If Err <> 0 Then
            'failed to open back end database
            Exit Function
        End If
        'in case back end has different table name than front end
        TblName = DLookup("ForeignName", "MSysObjects", "Name='" & TblName & "' And Type=6")
    End If

'get table
    Set Td = Db.TableDefs(TblName)
    If Err <> 0 Then
        'failed to get table
        GoTo Done
    End If

'if IsAutoNumber, then use the correct field Type
    If Not IsMissing(IsAutoNumber) Then
        If IsAutoNumber Then
            FldType = dbLong
        End If
    End If

'add field and properties
    With Td
        'create field
        If FldType = dbText And Not IsMissing(FldSize) Then
            Set Fd = .CreateField(FldName, FldType, FldSize)
        Else
            Set Fd = .CreateField(FldName, FldType)
        End If
        
        'position (0 is first position)
        If Not IsMissing(FldPos) Then
            Dim Num As Integer
            For Num = 0 To FldPos - 1
                Td.Fields(Num).OrdinalPosition = Num
            Next
            For Num = FldPos To .Fields.Count - 1
                Td.Fields(Num).OrdinalPosition = Num + 1
            Next
        End If
        
        'if IsAutoNumber
        If Not IsMissing(IsAutoNumber) Then
            If IsAutoNumber Then
                Fd.Attributes = 17
            End If
        End If
        
        'add field to table
        .Fields.Append Fd
        If Err <> 0 Then
            'failed to add field - probably already exists
            GoTo Done
        End If
        
        'default
        If Not IsMissing(DefaultValue) Then
            .Fields(FldName).DefaultValue = DefaultValue
        End If
        
        'add description property
        If Not IsMissing(FldDes) Then
             Set p = .Fields(FldName).CreateProperty("Description", dbText, FldDes)
             .Fields(FldName).Properties.Append p
        End If
        
        'other properties according to personal preference
        If FldType = dbText Then
            .Fields(FldName).AllowZeroLength = True
        End If
        
        
    End With

    AddFieldToTable = True 'defaults to false if it fails to get here
    
'clean up
Done:
    Set Fd = Nothing
    Set Td = Nothing
    If Not Db Is Nothing Then Db.Close
    Set Db = Nothing
End Function


Sub CallAddField()
Dim Result As Boolean

'sample call:
Result = AddFieldToTable("Table1", "NewFieldName", dbText, 2, 10, , "sample description")
Debug.Print Result

'Possible values for FldType parameter:
' dbBigInt (Decimal)
' dbBinary
' dbBoolean (Yes/No)
' dbByte
' dbCurrency
' dbDate
' dbDouble
' dbGUID (Replication ID)
' dbInteger
' dbLong (Long Integer)
' dbLongBinary (OLE Object)
' dbMemo
' dbSingle
' dbText (specify size, or length of text)
' dbVarBinary (OLE Object)

'FldPos parameter is the ordinal position, 0 being position 1,
'  but it works sporadically - I don't know why.
'For optional IsAutoNumber parameter, use True or False, or leave blank.
End Sub

Delete Field From Table

The function DeleteFieldFromTable works both if the table is linked or local, because the code checks what kind of table it is. The subroutine CallDeleteField has sample code to call the function. 


Function DeleteFieldFromTable(ByVal TblName As String, FldName As String) As Boolean
Dim Db As Database
Dim DbPath As Variant
Dim Td As TableDef

On Error Resume Next

'get back end path of linked table
    DbPath = DLookup("Database", "MSysObjects", "Name='" & TblName & "' And Type=6")
    If IsNull(DbPath) Then
        Set Db = CurrentDb 'if local table
    Else
        Set Db = OpenDatabase(DbPath) 'if linked table
        If Err <> 0 Then
            'failed to open back end database
            Exit Function
        End If
        'in case back end has different table name than front end
        TblName = DLookup("ForeignName", "MSysObjects", "Name='" & TblName & "' And Type=6")
    End If

'get table
    Set Td = Db.TableDefs(TblName)
    If Err <> 0 Then
        'failed to get table
        GoTo Done
    End If

'add field and properties
    With Td
        'delete field
        .Fields.Delete FldName
        If Err <> 0 Then
            'failed to delete field - probably doesn't exist
            GoTo Done
        End If
    End With

    DeleteFieldFromTable = True 'defaults to false if it fails to get here
    
'clean up
Done:
    Set Td = Nothing
    If Not Db Is Nothing Then Db.Close
    Set Db = Nothing
End Function


Sub CallDeleteField()
Dim Result As Boolean

'sample call:
Result = DeleteFieldFromTable("Table1", "Field1")
Debug.Print Result
End Sub

Rename Field

The function ChangeFieldName works both if the table is linked or local, because the code checks what kind of table it is. The subroutine CallChangeFieldName has sample code to call the function. 


Function ChangeFieldName(TblName As String, OldFldName As String, NewFldName As String)
Dim Td As TableDef
Dim Db As Database
Dim DbPath As Variant
Dim FldPos As Integer
Dim rs As Recordset
Dim IdxName As String

'get back end path of linked table
    DbPath = DLookup("Database", "MSysObjects", "Name='" & TblName & "' And Type=6")
    If IsNull(DbPath) Then
        Set Db = CurrentDb 'if local table
    Else
        Set Db = OpenDatabase(DbPath) 'if linked table
        If Err <> 0 Then
            'failed to open back end database
            Exit Function
        End If
        'in case back end has different table name than front end
        TblName = DLookup("ForeignName", "MSysObjects", "Name='" & TblName & "' And Type=6")
    End If

'get table
    Set Td = Db.TableDefs(TblName)
    If Err <> 0 Then
        'failed to get table
        GoTo Done
    End If

'change field name
    Td.Fields(OldFldName).Name = NewFldName

ChangeFieldName = True  'defaults to false if it fails to get here

Done:
If Not Db Is Nothing Then Db.Close
End Function


Sub CallChangeFieldName()
Dim Result As Boolean

'sample call:
Result = ChangeFieldName("Table1", "OldFieldName", "NewFieldName")
Debug.Print Result
End Sub

Change Field Type (from number to text, or vice versa)

The function ChangeFieldType works both if the table is linked or local, because the code checks what kind of table it is. This calls GetIndexes which is listed separately at the bottom of this page. The subroutine CallChangeFieldType has sample code to call the function. 


Function ChangeFieldType(ByVal TblName As String, FldName As String, NewType As Long, Optional DefaultValue, Optional FldSize) As Boolean
Dim Td As TableDef
Dim Db As Database
Dim DbPath As Variant
Dim FldPos As Integer
Dim rs As Recordset
Dim IdxNames As Variant
Dim IdxFldName As String
Dim IdxNum As Integer
Dim x As Integer

On Error Resume Next

'get back end path of linked table
    DbPath = DLookup("Database", "MSysObjects", "Name='" & TblName & "' And Type=6")
    If IsNull(DbPath) Then
        Set Db = CurrentDb 'if local table
    Else
        Set Db = OpenDatabase(DbPath) 'if linked table
        If Err <> 0 Then
            'failed to open back end database
            Exit Function
        End If
        'in case back end has different table name than front end
        TblName = DLookup("ForeignName", "MSysObjects", "Name='" & TblName & "' And Type=6")
    End If

'get table
    Set Td = Db.TableDefs(TblName)
    If Err <> 0 Then
        'failed to get table
        GoTo Done
    End If

'change field type
    If Td.Fields(FldName).Type <> NewType Then
        With Td
        
            On Error Resume Next
            If NewType = dbText And Not IsMissing(FldSize) Then
                .Fields.Append .CreateField("TempFld", NewType, FldSize)
            Else
                .Fields.Append .CreateField("TempFld", NewType)
            End If
            If Err <> 0 Then GoTo Done
            
            If NewType = dbText Or NewType = dbMemo Then
                .Fields("TempFld").AllowZeroLength = True 'personal preference
            End If
            
            FldPos = .Fields(FldName).OrdinalPosition
            .Fields("TempFld").OrdinalPosition = FldPos
            
            If Not IsMissing(DefaultValue) Then
                .Fields("TempFld").DefaultValue = DefaultValue
            End If
            
            Set rs = Db.OpenRecordset(TblName)
            While Not rs.EOF
                rs.Edit
                If NewType = dbText Or NewType = dbMemo Then
                    If Not IsNull(rs.Fields(FldName)) Then
                        rs!TempFld = Eval(rs.Fields(FldName))
                    End If
                Else
                    rs!TempFld = rs.Fields(FldName)
                End If
                rs.Update
                rs.MoveNext
            Wend
            rs.Close
            
            'get indexes used by this field
            IdxNames = GetIndexes(Td, FldName)
            'temporarily delete indexes used by this field
            For IdxNum = UBound(IdxNames, 2) To 0 Step -1
                If IdxNames(0, IdxNum) > "" Then .Indexes.Delete IdxNames(0, IdxNum)
            Next
            
            'delete old field
            .Fields.Delete FldName
            'rename new field to original
            .Fields("TempFld").Name = FldName
        
            'restore indexes
            For IdxNum = 0 To UBound(IdxNames, 2)
                If IdxNames(0, IdxNum) > "" Then
                    Dim Idx As Index
                    Set Idx = .CreateIndex(IdxNames(0, IdxNum))
                    'parse comma-delimited field names and add them to index
                    While Len(IdxNames(8, IdxNum)) > 1
                        x = InStr(IdxNames(8, IdxNum), ",")
                        IdxFldName = left(IdxNames(8, IdxNum), x - 1)
                        Idx.Fields.Append Td.CreateField(IdxFldName)
                        IdxNames(8, IdxNum) = Mid(IdxNames(8, IdxNum), x + 1)
                    Wend
                    'assign properties to index
                    For x = 1 To 7
                        Idx.Properties(x) = IdxNames(x, IdxNum)
                    Next
                    'add the index
                    .Indexes.Append Idx
                End If
            Next
            
        End With
    
        If Err <> 0 Then GoTo Done
            
    End If

ChangeFieldType = True  'defaults to false if it fails to get here

Done:
If Not Db Is Nothing Then Db.Close
End Function


Sub CallChangeFieldType()
Dim Result As Boolean

'sample call:
Result = ChangeFieldType("Table1", "Field1", dbText, , 10)
Debug.Print Result

'Possible values for FldType parameter:
' dbBigInt (Decimal)
' dbBinary
' dbBoolean (Yes/No)
' dbByte
' dbCurrency
' dbDate
' dbDouble
' dbGUID (Replication ID)
' dbInteger
' dbLong (Long Integer)
' dbLongBinary (OLE Object)
' dbMemo
' dbSingle
' dbText (specify size, or length of text)
' dbVarBinary (OLE Object)
End Sub

Change Field Size (for text fields)

The function ChangeFieldSize works both if the table is linked or local, because the code checks what kind of table it is. This calls GetIndexes which is listed separately at the bottom of this page. The subroutine CallChangeFieldSize has sample code to call the function. 


Function ChangeFieldSize(TblName As String, FldName As String, NewSize As Byte)
Dim Td As TableDef
Dim Db As Database
Dim DbPath As Variant
Dim FldPos As Integer
Dim rs As Recordset
Dim IdxNames As Variant
Dim IdxFldName As String
Dim IdxNum As Integer
Dim x As Integer

'get back end path of linked table
    DbPath = DLookup("Database", "MSysObjects", "Name='" & TblName & "' And Type=6")
    If IsNull(DbPath) Then
        Set Db = CurrentDb 'if local table
    Else
        Set Db = OpenDatabase(DbPath) 'if linked table
        If Err <> 0 Then
            'failed to open back end database
            Exit Function
        End If
        'in case back end has different table name than front end
        TblName = DLookup("ForeignName", "MSysObjects", "Name='" & TblName & "' And Type=6")
    End If

'get table
    Set Td = Db.TableDefs(TblName)
    If Err <> 0 Then
        'failed to get table
        GoTo Done
    End If

'change field size
    If Td.Fields(FldName).Size <> NewSize Then
        With Td
        
            On Error Resume Next
            If NewSize > 0 And NewSize < 256 Then 'text field
                .Fields.Append .CreateField("TempFld", dbText, NewSize)
            Else '0 is memo field
                .Fields.Append .CreateField("TempFld", dbMemo)
            End If
            
            .Fields("TempFld").AllowZeroLength = True 'personal preference
            FldPos = .Fields(FldName).OrdinalPosition
            .Fields("TempFld").OrdinalPosition = FldPos
            
            Set rs = Db.OpenRecordset(TblName)
            While Not rs.EOF
                rs.Edit
                rs!TempFld = rs.Fields(FldName)
                rs.Update
            rs.MoveNext
            Wend
            rs.Close
            
            'get indexes used by this field
            IdxNames = GetIndexes(Td, FldName)
            'temporarily delete indexes used by this field
            For IdxNum = UBound(IdxNames, 2) To 0 Step -1
                If IdxNames(0, IdxNum) > "" Then .Indexes.Delete IdxNames(0, IdxNum)
            Next
            
            'delete old field
            .Fields.Delete FldName
            'rename new field to original
            .Fields("TempFld").Name = FldName
        
            'restore indexes
            For IdxNum = 0 To UBound(IdxNames, 2)
                If IdxNames(0, IdxNum) > "" Then
                    Dim Idx As Index
                    Set Idx = .CreateIndex(IdxNames(0, IdxNum))
                    'parse comma-delimited field names and add them to index
                    While Len(IdxNames(8, IdxNum)) > 1
                        x = InStr(IdxNames(8, IdxNum), ",")
                        IdxFldName = left(IdxNames(8, IdxNum), x - 1)
                        Idx.Fields.Append Td.CreateField(IdxFldName)
                        IdxNames(8, IdxNum) = Mid(IdxNames(8, IdxNum), x + 1)
                    Wend
                    'assign properties to index
                    For x = 1 To 7
                        Idx.Properties(x) = IdxNames(x, IdxNum)
                    Next
                    'add the index
                    .Indexes.Append Idx
                End If
            Next
            
        End With
        
        If Err <> 0 Then GoTo Done
            
    End If

ChangeFieldSize = True  'defaults to false if it fails to get here

Done:
If Not Db Is Nothing Then Db.Close
End Function


Sub CallChangeFieldSize()
Dim Result As Boolean

'sample call:
Result = ChangeFieldSize("Table1", "Field1", 15)
Debug.Print Result
End Sub

Add Index To Table

The function AddIndexToTable works both if the table is linked or local, because the code checks what kind of table it is. The subroutine CallAddIndex has sample code to call the function. 


Function AddIndexToTable(ByVal TblName As String, IndexName As String, IsPrimary As Boolean, _
                         IsUnique As Boolean, ParamArray FldNames()) As Boolean
Dim Idx As Index
Dim Td As TableDef
Dim DbPath As Variant
Dim Db As Database
Dim FldNum As Integer

On Error Resume Next

'get back end path of linked table
    DbPath = DLookup("Database", "MSysObjects", "Name='" & TblName & "' And Type=6")
    If IsNull(DbPath) Then
        Set Db = CurrentDb 'if local table
    Else
        Set Db = OpenDatabase(DbPath) 'if linked table
        If Err <> 0 Then
            'failed to open back end database
            Exit Function
        End If
        'in case back end has different table name than front end
        TblName = DLookup("ForeignName", "MSysObjects", "Name='" & TblName & "' And Type=6")
    End If

'get table
    Set Td = Db.TableDefs(TblName)
    If Err <> 0 Then
        'failed to get table
        GoTo Done
    End If

With Td
    On Error Resume Next
    Set Idx = .Indexes(IndexName) 'test for existence
    If Err = 0 Then GoTo Done
    
    If Err > 0 Then 'create index
        On Error Resume Next
        Set Idx = .CreateIndex(IndexName)
        With Idx
            For FldNum = 0 To UBound(FldNames)
                .Fields.Append .CreateField(FldNames(FldNum))
            Next
            .IgnoreNulls = True
            .Primary = IsPrimary
            .Unique = IsUnique
        End With
        .Indexes.Append Idx
    End If
    
End With
    
If Err = 0 Then AddIndexToTable = True

Done:
End Function


Sub CallAddIndex()
Dim Result As Boolean

'sample call:
Result = AddIndexToTable("Table1", "MyIndex", False, True, "Field1", "Field2")
Debug.Print Result

'For the FldNames parameter, include one or more field names.
'Field2, Field3, etc. is optional
End Sub

Delete Index From Table

The function DeleteIndexFromTable works both if the table is linked or local, because the code checks what kind of table it is. The subroutine CallDeleteIndex has sample code to call the function. 


Function DeleteIndexFromTable(ByVal TblName As String, IndexName As String) As Boolean
Dim Idx As Index
Dim Td As TableDef
Dim DbPath As Variant
Dim Db As Database

On Error Resume Next

'get back end path of linked table
    DbPath = DLookup("Database", "MSysObjects", "Name='" & TblName & "' And Type=6")
    If IsNull(DbPath) Then
        Set Db = CurrentDb 'if local table
    Else
        Set Db = OpenDatabase(DbPath) 'if linked table
        If Err <> 0 Then
            'failed to open back end database
            Exit Function
        End If
        'in case back end has different table name than front end
        TblName = DLookup("ForeignName", "MSysObjects", "Name='" & TblName & "' And Type=6")
    End If

'get table
    Set Td = Db.TableDefs(TblName)
    If Err <> 0 Then
        'failed to get table
        GoTo Done
    End If

With Td
    On Error Resume Next
    .Indexes.Delete IndexName
End With
    
If Err = 0 Then DeleteIndexFromTable = True

Done:
End Function


Sub CallDeleteIndex()
Dim Result As Boolean

'sample call:
Result = DeleteIndexFromTable("Table1", "MyIndex")
Debug.Print Result
End Sub

Drop Table From Back End Database

The function DeleteTableFromBackEnd works for any remote database named in the DbPath parameter. That parameter should contain the complete path and database name. The subroutine CallDeleteTableFromBackEnd has sample code to call the function. 


Function DeleteTableFromBackEnd(DbPath As String, TblName As String)
'This is dangerous - be careful! Make a backup of the back end database first.
Dim Db As Database

'test back end
    On Error Resume Next
    Set Db = OpenDatabase(DbPath)
    If Err <> 0 Then
        'failed to open back end database
        Exit Function
    End If
    Db.Execute "DROP TABLE [" & TblName & "]"
    If Not Db Is Nothing Then Db.Close

    DeleteTableFromBackEnd = True 'defaults to false if it fails to get here
    
Done:
End Function


Sub CallDeleteTableFromBackEnd()
'This is dangerous - be careful! Make a backup of the back end database first.
Dim Result As Boolean

'sample call:
Result = DeleteTableFromBackEnd("C:\Sample.mdb", "Table1")
Debug.Print Result
End Sub

Export Table To Back End Database

The function PutTableOnBackEnd works for any remote database named in the DbPath parameter. That parameter should contain the complete path and database name. The subroutine CallPutTableOnBackEnd has sample code to call the function. 


Function PutTableOnBackEnd(DBName As String, TblName As String) As Boolean
'DBName should include full path and name of back end database
Dim Db As Database

'test back end
    On Error Resume Next
    Set Db = OpenDatabase(DBName)
    If Err <> 0 Then
        'failed to open back end database
        Exit Function
    End If
    If Not Db Is Nothing Then Db.Close

'test if table is local
    If IsNull(DLookup("Type", "MSysObjects", "Name='" & TblName & "' AND Type=1")) Then
        'table is not local
        Exit Function
    End If

'put table on back end
    DoCmd.TransferDatabase acExport, "Microsoft Access", DBName, acTable, TblName, TblName
    If Err <> 0 Then GoTo Done
    
'link to the back end table
    DoCmd.DeleteObject acTable, TblName
    DoCmd.TransferDatabase acLink, "Microsoft Access", DBName, acTable, TblName, TblName
    
    PutTableOnBackEnd = True 'defaults to false if it fails to get here

Done:
End Function


Sub CallPutTableOnBackEnd()
Dim Result As Boolean

'sample call:
Result = PutTableOnBackEnd("C:\Sample.mdb", "Table1")
Debug.Print Result
End Sub

Import Table Into Front End Database

The function PutTableOnFrontEnd automatically figures out the path of the remote database containing the table to grab. The subroutine CallPutTableOnFrontEnd has sample code to call the function. 


Function PutTableOnFrontEnd(ByVal TblName As String) As Boolean
Dim DbPath As Variant

'get back end path of linked table
    DbPath = DLookup("Database", "MSysObjects", "Name='" & TblName & "' And Type=6")
    If IsNull(DbPath) Then
        Exit Function 'if local table
    End If

'delete linked table
    On Error Resume Next
    DoCmd.DeleteObject acTable, TblName
    
'import the table unlinked
    DoCmd.TransferDatabase acImport, "Microsoft Access", DbPath, acTable, TblName, TblName
    If Err <> 0 Then GoTo Done
    
    PutTableOnFrontEnd = True 'defaults to false if it fails to get here
    
Done:
End Function


Sub CallPutTableOnFrontEnd()
Dim Result As Boolean

'sample call:
Result = PutTableOnFrontEnd("Table1")
Debug.Print Result
End Sub

Link All Tables From Back End Database

The function LinkTables creates links to all the tables in the remote database. The DbPath parameter should contain the complete path and database name. The subroutine CallLinkTables has sample code to call the function. 


Function LinkTables(DbPath As String) As Boolean
'This links to all the tables that reside in DbPath,
'  whether or not they already reside in this database.
'This works when linking to an Access .mdb file, not to ODBC.
'This keeps the same table name on the front end as on the back end.
Dim rs As Recordset

    On Error Resume Next

'get tables in back end database
    Set rs = CurrentDb.OpenRecordset("SELECT Name " & _
                                    "FROM MSysObjects IN '" & DbPath & "' " & _
                                    "WHERE Type=1 AND Flags=0")
    If Err <> 0 Then Exit Function

'link the tables
    While Not rs.EOF
        If DbPath <> Nz(DLookup("Database", "MSysObjects", "Name='" & rs!Name & "' And Type=6")) Then
            'delete old link, assuming front and back end table have the same name
            DoCmd.DeleteObject acTable, rs!Name
            'make new link
            DoCmd.TransferDatabase acLink, "Microsoft Access", DbPath, acTable, rs!Name, rs!Name
        End If
        rs.MoveNext
    Wend
    rs.Close

    LinkTables = True
End Function


Sub CallLinkTables()
Dim Result As Boolean

'sample call:
Result = LinkTables("C:\Program Files\Microsoft Office\Office\Samples\Northwind.mdb")
Debug.Print Result
End Sub

Relink Tables With Broken Links

The function ReLinkTables changes the table links from old broken ones to new valid ones. Both parameters should contain the complete path and database name. The subroutine CallReLinkTables has sample code to call the function. Notice that the sample code first calls the GetUnLinked function to find out if any tables have broken links. By the way, the RefreshLink method doesn't work for me consistently. So this code creates the links from scratch. 


Function ReLinkTables(OldDbPath As String, NewDbPath As String) As Boolean
'This relinks only the tables that reside in this database
'  that have a (broken) link to OldDbPath.
'This works when linking to an Access .mdb file, not to ODBC.
'This keeps the same table name on the front end,
'  even if it's different than the back end table name.
Dim rs As Recordset
Dim Db As Database
Dim TblName As String
Dim ForeignTblName As String

    On Error Resume Next

'test for valid back end path
    Set Db = OpenDatabase(NewDbPath)
    If Err <> 0 Then Exit Function
    Db.Close

'get tables in this database with old link
    Set rs = CurrentDb.OpenRecordset("SELECT Name, ForeignName " & _
                                    "FROM MSysObjects " & _
                                    "WHERE Database='" & OldDbPath & "'")
    If Err <> 0 Then Exit Function

'relink the tables
    While Not rs.EOF
        TblName = rs!Name
        ForeignTblName = rs!ForeignName
        'delete old link
        DoCmd.DeleteObject acTable, TblName
        'make new link, retaining the front end name, even if the back end name is different
        DoCmd.TransferDatabase acLink, "Microsoft Access", NewDbPath, acTable, ForeignTblName, TblName
        
        rs.MoveNext
    Wend
    rs.Close
    
    ReLinkTables = True
End Function


Sub CallReLinkTables()
Dim Result As Boolean
Dim OldDbPath As String

'find broken links
OldDbPath = GetUnLinked

'if we have broken links ...
If OldDbPath > "" Then
    'sample call:
    Result = ReLinkTables(OldDbPath, "C:\Program Files\Microsoft Office\Office\Samples\Northwind.mdb")
    Debug.Print Result
End If
End Sub


Function GetUnLinked() As String
'Returns database path of first unlinked table it finds.
'This checks for valid path for back end, but it
'does not check that the table itself actually resides on back end.
Dim rs As Recordset
Dim Db As Database

    Set rs = CurrentDb.OpenRecordset("SELECT Database FROM MSysObjects " & _
                                     "GROUP BY Database HAVING Database Is Not Null")
    While Not rs.EOF
        On Error Resume Next
        Set Db = OpenDatabase(rs!Database)
        If Err <> 0 Then
            'return database path of unlinked table
            GetUnLinked = rs!Database
            GoTo Done
        End If
        Db.Close
        rs.MoveNext
    Wend

Done:
    rs.Close
End Function

Get Indexes In Table

Access won't let you change a field type or a field size if that field belongs to an index. Therefore, it's necessary to delete the index, modify the field, and restore the index. The function GetIndexes finds all the indexes containing the given field. It returns an array containing the index names and all the index properties so that you can restore them later. This function is called by the functions ChangeFieldSize and ChangeFieldType above. 


Function GetIndexes(Td As TableDef, FldName As String)
'Returns array of indexes containing the specified field,
' the first index starting at Idx(1), so that
' Ubound(2, Idx) equals the number of indexes having the specified field
Dim IdxNum As Integer, FldNum As Integer, PropNum As Integer
Dim IdxNames() As String 'array to hold indexes
ReDim IdxNames(8, 0) 'first dimension contains the index properties and field names
                'second dimension represents index number
Dim FldNames As String

    For IdxNum = 0 To Td.Indexes.Count - 1
        FldNames = ""
        For FldNum = 0 To Td.Indexes(IdxNum).Fields.Count - 1
            'concatonate field names
            FldNames = FldNames & Td.Indexes(IdxNum).Fields(FldNum).Name & ","
            'if index contains the field we're looking for ...
            If FldName = Td.Indexes(IdxNum).Fields(FldNum).Name Then
                If IdxNum > 0 Then ReDim Preserve IdxNames(8, IdxNum)
                'properties go into first 7 places of first dimension
                For PropNum = 0 To 7
                    IdxNames(PropNum, IdxNum) = Td.Indexes(IdxNum).Properties(PropNum)
                Next
            End If
        Next
        'field names go into 8th place of first dimension
        If IdxNames(8, UBound(IdxNames, 2)) = "" Then IdxNames(8, UBound(IdxNames, 2)) = FldNames
    Next
    
    GetIndexes = IdxNames
End Function

Download all functions
Import the downloaded .bas file as a new module into your Access database.

Wizard to Manage Remote Database
This wizard uses VBA code similar to that above, and it incorporates it into a graphical user interface. So by pointing and clicking you can modify tables, fields, and indexes on your remote backend database, without even opening the database.

Cool Tools for Access
Achieve dazzling results in record time. Automate tedious programming tasks (forms, queries, reports) with ingenious guru tools.

Alternative Security Tool
Intuitive security wizard makes it easier to move users to and from groups.

Image File Utility
Browse image files using MS Access image control, search by title or by description, copy to other folders.