How to update the server name for all ODBC linked SQL Server tables using Access VBA

Question

I need to be able to provide a method to update the server name in all ODBC linked table connections in an Access database. All tables have been migrated out of Access to a SQL Express instance. An option is needed to update all external table links to point from "Localhost\SQLExpress" to a SQL instance on another server. The database name will remain consistent. Only the Server instance name needs to be updated.

I've found examples of how to do this for connections to Access database files and Excel files, but not ODBC connections to SQL Server. One post here pointed out the need to dimension a db object and use it directly instead of trying to use CurrentDb directly. That got me further, but now the code fails with a type conversion when trying to assign the new connection string to the TableDef.

Dim OldServer As String
Dim NewServer As String
Dim OldPath As String
Dim NewPath As String
Dim strPath As String

NewServer = Me.NewServerInstance ' get new Server Instance name from form
OldPath = GetCurrentPath("Version")
'Parse old name from the ODBC connection string
OldServer = Replace(Left(OldPath, InStr(GetCurrentPath("Version"), "UID=") - 2), "ODBC Driver 13 for SQL Server;SERVER=", "")
NewPath = Replace(OldPath, OldServer, NewServer)

If NewServer = OldServer Then
GoTo UpdateInstance_Click_Exit
Else
    'update all table connection strings. 
    'Loop & replace Old server instance with New server instance
    Dim Db As DAO.Database
    Set Db = CurrentDb
    Dim td As DAO.TableDef
    For Each td In Db.TableDefs
        If (td.Attributes And dbAttachedODBC) = dbAttachedODBC Then
            Db.TableDefs(td).Connect = NewPath 'getting a datatype conversion error here...
            Db.TableDefs(td).RefreshLink
'           MsgBox (db.TableDefs(td).Connect)
        End If
    Next
End If

The code example is what I came up with. There is a comment indicating the point where a datatype conversion error occurs. I guess I need to know if this is this even possible, or if I am trying to do something that is not possible, or just going about it the wrong way...

Gustav Gustav · Accepted Answer · 2019-05-10T06:43:25

We use this code where you call AttachSqlServer with the four arguments needed:

Public Function ConnectionString( _
    ByVal Hostname As String, _
    ByVal Database As String, _
    ByVal Username As String, _
    ByVal Password As String) _
    As String

' Create ODBC connection string from its variable elements.
' 2016-04-24. Cactus Data ApS, CPH.

    Const AzureDomain   As String = ".windows.net"
    Const OdbcConnect   As String = _
        "ODBC;" & _
        "DRIVER=SQL Server Native Client 11.0;" & _
        "Description=Application Name;" & _
        "APP=Microsoft? Access;" & _
        "SERVER={0};" & _
        "DATABASE={1};" & _
        "UID={2};" & _
        "PWD={3};" & _
        "Trusted_Connection={4};"

'    Const cstrConnect   As String = _
'        "ODBC;Driver=SQL Server Native Client 11.0;Server=(localdb)\MSSQLLocalDB;Database=Test;Trusted_Connection=Yes"

    Dim FullConnect     As String

    If Right(Hostname, Len(AzureDomain)) = AzureDomain Then
        ' Azure SQL connection.
        ' Append servername to username.
        Username = Username & "@" & Split(Hostname)(0)
    End If
    FullConnect = OdbcConnect
    FullConnect = Replace(FullConnect, "{0}", Hostname)
    FullConnect = Replace(FullConnect, "{1}", Database)
    FullConnect = Replace(FullConnect, "{2}", Username)
    FullConnect = Replace(FullConnect, "{3}", Password)
    FullConnect = Replace(FullConnect, "{4}", IIf(Username & Password = "", "Yes", "No"))

    ConnectionString = FullConnect

End Function

Public Function AttachSqlServer( _
    ByVal Hostname As String, _
    ByVal Database As String, _
    ByVal Username As String, _
    ByVal Password As String) _
    As Boolean

' Attach all tables linked via ODBC to SQL Server or Azure SQL.
' 2016-04-24. Cactus Data ApS, CPH.

    Const cstrDbType    As String = "ODBC"
    Const cstrAcPrefix  As String = "dbo_"

    Dim dbs             As DAO.Database
    Dim tdf             As DAO.TableDef
    Dim qdf             As DAO.QueryDef

    Dim strConnect      As String
    Dim strName         As String

    On Error GoTo Err_AttachSqlServer

    Set dbs = CurrentDb
    strConnect = ConnectionString(Hostname, Database, Username, Password)

    For Each tdf In dbs.TableDefs
        strName = tdf.Name
        If Asc(strName) <> Asc("~") Then
            If InStr(tdf.Connect, cstrDbType) = 1 Then
                If Left(strName, Len(cstrAcPrefix)) = cstrAcPrefix Then
                    tdf.Name = Mid(strName, Len(cstrAcPrefix) + 1)
                End If
                tdf.Connect = strConnect
                tdf.RefreshLink
                Debug.Print Timer, tdf.Name, tdf.SourceTableName, tdf.Connect
                DoEvents
            End If
        End If
    Next

    For Each qdf In dbs.QueryDefs
        If qdf.Connect <> "" Then
            Debug.Print Timer, qdf.Name, qdf.Type, qdf.Connect
            qdf.Connect = strConnect
        End If
    Next
    Debug.Print "Done!"

    AttachSqlServer = True

Exit_AttachSqlServer:
    Set tdf = Nothing
    Set dbs = Nothing
    Exit Function

Err_AttachSqlServer:
 '   Call ErrorMox
    Resume Exit_AttachSqlServer

End Function

How to update the server name for all ODBC linked SQL Server tables using Access VBA

1 Answers