Creating linked tables in MS Access using VBA

Recently I ran into a system that used Oracle as back-end database and an MS Access database/app containing the forms as front-end for the users. The Access database connected to Oracle tables and views using ODBC linked tables. We had about 5 different Oracle servers for development, test, acceptance and production. Due to a lot of legacy code the table names in Access and Oracle weren’t always the same.

Frequently we needed to change to which Oracle server a specific instance of the Access app would talk to. Instead of manually removing and relinking the tables, I created a simple local table to define which tables should exist in the Access database and what the tables name on the Oracle server should be. A simple VBA subroutine actually establishes the links.

Here’s a short version of it:

Option Compare Database
Option Explicit
Private Const gDSNTemplate = "ODBC;DRIVER={Oracle in OraHome817};SERVER=${server};UID=${user};PWD=${password};DBQ=${server};DBA=W;APA=T;EXC=F;XSM=Default;FEN=T;QTO=T;FRC=10;FDL=10;L...(cant remember the rest)..."
Public Sub LinkTables(Server As String, username As String, password As String)
    Dim dsn As String
    Dim strAccessName As String
    Dim strOracleName As String
    Dim tDef As TableDef
    Dim rs As Recordset

    'Create the DSN for the requested environment
    dsn = gDSNTemplate
    dsn = Replace(dsn, "${server}", Server)
    dsn = Replace(dsn, "${user}", username)
    dsn = Replace(dsn, "${password}", password)

    Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblLinkedTables")
    Do While Not rs.EOF
        strAccessName = rs!AccessName
        strOracleName = rs!OracleName
        'Remove the outdated linked table 
        '(ignore the error if doesn't exist)
        On Error Resume Next
        DoCmd.DeleteObject acTable, strAccessName
        On Error GoTo 0
        'Create the linked table
        Set tDef = CurrentDb.CreateTableDef(strAccessName, dbAttachSavePWD)
        tDef.Connect = dsn
        tDef.SourceTableName = strOracleName
        CurrentDb.TableDefs.Append tDef
End Sub