Changing SQL DB via ODBC Connection in MS Access


  • Is there a global way of updating a MS Access DB that connects to SQL Database?  

    I refreshed the network saved DSN file to point to the new SQL Database (on another server) but it appears that I have to update each table thru Linked Table Manager, as the refreshed DSN file changes are not automatically applying.  Very time consuming.  I want to retain the queries, forms and reports I already have.

    If I update the tables, does this also refresh queries, forms, reports, etc.

    Wednesday, October 28, 2009 6:29 PM

All replies

  • I know exactly what you are talking about.  I have written some vba script to update all the SQL Linked Tables in a database.  See below:

    This code should be used in a separate database than your other applications.

    Before running the script you need to create a table:
    DoCmd.RunSQL "CREATE TABLE tblPending ([Source Name] VARCHAR(255),[Linked Name] VARCHAR(255),[Database Name] VARCHAR(255))"

    Place the code below into a new Module:

    Option Compare Database
    Option Explicit
    Private db As DAO.Database
    Private b As Byte
    Private bolError As Boolean
    Private rs As DAO.Recordset
    Private tbl As DAO.TableDef
    Public Sub RelinkSQLTablesTo(strAccessDatabasePath As String, Optional strInstance As String = "MyInstance", Optional strDatabase As String = "MyDatabase")
    DoCmd.SetWarnings False
    DoCmd.RunSQL "DELETE FROM tblPending"
    DoCmd.SetWarnings True
    Set rs = CurrentDb.OpenRecordset("tblPending")
    b = 0
    Set db = DBEngine.OpenDatabase(strAccessDatabasePath)
    For Each tbl In db.TableDefs
        If tbl.Connect Like "*SQL Server*" Then
            rs![source name] = Replace(tbl.SourceTableName, "dbo.", "")
            rs![database name] = DatabaseName(tbl.Connect)
            rs![linked name] = tbl.Name
        End If
    Next tbl
    Do Until rs.EOF
        LinkSQLTable strInstance, rs![source name], strDatabase, rs![linked name], Left$(FileName(db.Name), Len(FileName(db.Name)) - 4)
    Set db = Nothing
    MsgBox b & " tables affected", vbInformation
    DoCmd.Quit acQuitPrompt
    End Sub
    Private Function DatabaseName(strConnection As String) As String
    strConnection = Mid(strConnection, InStr(1, strConnection, "DATABASE=") + 9, Len(strConnection))
    DatabaseName = Left(strConnection, InStr(1, strConnection, ";") - 1)
    End Function
    Private Function FileName(strFileName As String) As String
    Dim lnNuvPos As Integer
    Dim lnPos As Integer
    lnNuvPos = 1
    Do While lnNuvPos <> 0
    lnPos = lnNuvPos + 1
    lnNuvPos = InStr(lnPos, strFileName, "\")
    FileName = Mid$(strFileName, lnPos, Len(strFileName))
    End Function
    Private Sub LinkSQLTable(strSource As String, strServerTable As String, strSQLDatabase As String, Optional strLinkedTableName As String, Optional strApplicationName As String)
    If strLinkedTableName = "" Then
        strLinkedTableName = strServerTable
    End If
    On Error GoTo ErrorChecks
    db.Execute "DROP TABLE [" & strLinkedTableName & "]"
    bolError = False
    Dim tblLinked As DAO.TableDef
    Set tblLinked = db.CreateTableDef(strLinkedTableName)
    tblLinked.Connect = "ODBC;DRIVER=SQL Server;" & _
                        "SERVER=" & strSource & ";" & _
                        "APP=" & strApplicationName & ";" & _
                        "TRUSTED_CONNECTION=YES;" & _
                        "PERSIST SECURITY INFO=NO;" & _
                        "DATABASE=" & strSQLDatabase
    tblLinked.SourceTableName = strServerTable
    tblLinked.Attributes = dbAttachSavePWD
    db.TableDefs.Append tblLinked
    Set tblLinked = Nothing
    b = b + 1
    Exit Sub
    If Err.Number = 3011 Or Err.Number = 3376 Then 'table does not exist
        If Err.Source = "MSAccess" Or Err.Source = "DAO.Database" Then
            Resume Next 'this will stop access from trying to delete a table that doesn't exist
            If bolError = True Then
                MsgBox "This table does not exist on SQL Server", vbInformation
                Exit Sub
            End If
        End If
        MsgBox Err.Number & vbNewLine & Err.Description
        Exit Sub
    End If
    End Sub

    An example to run: place into the Immediate window then press return:

    RelinkSQLTablesTo "C:\MyAccessDatabase.mdb","MYSERVER\MYINSTANCE","AdventureWorks"

    Hope this helps

    Saturday, November 07, 2009 11:52 PM