?
Solved

Relink Access tables from code

Posted on 2002-07-11
2
Medium Priority
?
1,440 Views
Last Modified: 2011-09-20
In my Front end Access 2000 database, I have several linked tables from SQL Server database.  How can I make sure that all tables get connected when the front end is opened? That is I am looking for some code that will check that the tables are connected and then if not it will connect them for me (w/o prompting me to do it).

ps. I found this which is perfect http://www.mvps.org/access/tables/tbl0009.htm except that it prompts the user to re-link the tables which I do not want to do.
0
Comment
Question by:mcottom
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
2 Comments
 
LVL 8

Expert Comment

by:dovholuk
ID: 7146813
if it works perfect, just comment out the line that says:

If MsgBox("Are you sure you want to reconnect all Access tables?", _
            vbQuestion + vbYesNo, "Please confirm...") = vbNo Then Err.Raise
cERR_USERCANCEL


or delete it entirely... then the user won't be asked.

enjoy! ;-)

dovholuk
0
 
LVL 7

Accepted Solution

by:
Daniel Stanley earned 1200 total points
ID: 7146865
try this out, i have a local table that houses the connect string that i want to use to link all of my database objects. from the form you select a dsn that you want to link to and then run the form.  i have included the code module that houses various function that are called during the relinking process by way of a attatchment form; i will inlcude the form code as well.  let me know if you'd like a copy of the form itself or if you need a full copy of the mdb to see it work properly; i find it works really well.  

good luck,
daniels@asix.com


====================
FORM CODE
====================
Option Compare Database
Option Explicit

Private Sub cmdCancel_Click()

    DoCmd.Close

End Sub

Private Sub cmdOK_Click()
   
    If IsNull(cboDataSource) Then
        MsgBox "Please select a data source.", vbInformation, "Incomplete Data"
    Else
        Call ap_RefreshAttachments(cboDataSource)
        DoCmd.Close
    End If

End Sub


===========================
MODULE CODE
===========================
Option Compare Database
Option Explicit

Option Base 1       'for using array in ap_CompareAscendConnect

'Note:  The declaration and usage of GetPrivateProfileString differs slightly from v2.0's 16-bit API call
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (
ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String,
ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

'Purpose:   Checks attachment of all ODBC-attached tables and SQL pass-through queries to ensure they match the
'             active connect string for the database
'Usage:     Call whenever database is opened (Autoexec macro)

Function ap_CompareAttachments()

    Dim db As Database, tdf As TableDef, qdf  As QueryDef
    Dim i As Integer
    Dim strCurrConnectFld As String
    Dim fMatchOk As Integer
    Dim strText As String
    Dim strTablesConnectRef As String
   
    Set db = CurrentDB()

    strCurrConnectFld = trim(Nz(DMin("[connectstr]", "connect_current"), Empty))

    If strCurrConnectFld = Empty Then
        MsgBox "Can't validate connections.  Please refresh attachments.", vbCritical, "Missing Current Connection"
    Else
        fMatchOk = True     'initialize return value for single elimination

        'Get the connection of an ODBC-attached table, to be used as the standard for comparison
        For Each tdf In db.TableDefs
            If tdf.Attributes And dbAttachedODBC Then
                strTablesConnectRef = tdf.Connect
                Exit For
            End If
        Next tdf
       
        'Check its host, service and database params against those of the active connect_string record
        fMatchOk = fMatchOk And (md_ParseConnectString(strCurrConnectFld, "HOST") = md_ParseConnectString(strTablesConnectRef, "HOST"))
        fMatchOk = fMatchOk And (md_ParseConnectString(strCurrConnectFld, "SERV") = md_ParseConnectString(strTablesConnectRef, "SERV"))
        fMatchOk = fMatchOk And (md_ParseConnectString(strCurrConnectFld, "DB") = md_ParseConnectString(strTablesConnectRef, "DB"))

        'Check each table's connection against the reference table's connection
        For Each tdf In db.TableDefs
            If tdf.Attributes And dbAttachedODBC Then      'ODBC-attached tables only
                fMatchOk = fMatchOk And (tdf.Connect = strTablesConnectRef)
            End If
        Next tdf
       
        'Check each pass-through query's connection against the recorded current connection.
        For Each qdf In db.QueryDefs
            If qdf.type = dbQSQLPassThrough Then      'SQL pass-through queries only
                fMatchOk = fMatchOk And (qdf.Connect = strCurrConnectFld)
            End If
        Next qdf
       
        If Not fMatchOk Then
            strText = "Some of the tables and queries in this reports database are not connected properly to the"
            strText = strText & " current data source.  Some reports may not function or may show incorrect"
            strText = strText & " data.  Please run the attachments utility to correct this."
            MsgBox strText, vbExclamation, "Inconsistent ODBC Connections"
        End If
   
    End If

End Function

Sub ap_RefreshAttachments(strDataSource)

    Dim db As Database, tdf As TableDef, qdf As QueryDef
    Dim strConnection As String
    Dim intI As Integer
    Dim varX As Variant
    Dim strSql As String
    'Variables added for Oracle
    Dim intPosn As Integer
    Dim fTargetOracle As Boolean
    Dim strTableName As String
    Dim strTmpNewTableObjName As String
   
    strConnection = trim(Nz(DLookup("[connectstr]", "connect_strings", "[server_name] = '" & strDataSource & "'"), Empty))
   
    If strConnection = Empty Then
        MsgBox "This server has no connection string - Try Again", vbExclamation, "Invalid Server Name"
    Else
        fTargetOracle = (InStr(1, strConnection, "SERV", vbTextCompare) = 0)    'Oracle connect strings do not have a SERVICE element
       
        Set db = CurrentDB()
       
        'Change connect strings for ODBC-attached tables.  (The For Each...Next construct is more modern and efficient, but
        'does not provide the counter needed for displaying a progress meter, thus the For...Next construct.)
        varX = SysCmd(acSysCmdInitMeter, "Reattaching Tables", db.TableDefs.Count)
        For intI = 0 To db.TableDefs.Count - 1
            Set tdf = db.TableDefs(intI)
            If tdf.Attributes And dbAttachedODBC Then
                'Added for issue 10471: In Access 2000, if user did not check "Save password" when first linking to a table, the setting
                'of the Connect property (below) no longer has the effect of setting the dbAttachSavePWD attribute to True.  The effect is that
                'the linked table's resulting Connect property is different from those tables where dbAttachSavePWD is True, and triggers
                'the "Inconsistent ODBC Connections" warning in ap_CompareAttachments.  The new code below explicitly checks for the condition
                'and fixes it.  The construct of the condition is necessary; checking for False is trickier than checking for True; it does not
                'work to check for "Not (tdf.Attributes And dbAttachSavePWD)".
                If (tdf.Attributes And dbAttachSavePWD) = 0 Then
                    tdf.Attributes = dbAttachSavePWD
                End If

                'tdf.Connect = strConnection
                ''On Error Resume Next      'already removed before Oracle conversion
                'tdf.RefreshLink
                ''On Error GoTo 0           'already removed before Oracle conversion

                'Begin new code for Oracle
                intPosn = InStr(1, tdf.SourceTableName, ".", vbTextCompare)
                strTableName = LCase(trim(Right(tdf.SourceTableName, Len(tdf.SourceTableName) - intPosn)))
               
                strTmpNewTableObjName = "new_" & strTableName
               
                Set tdf = db.CreateTableDef(strTmpNewTableObjName)
                tdf.Connect = strConnection
               
                If fTargetOracle Then
                    tdf.SourceTableName = "ASCEND." & UCase(strTableName)
                Else
                    tdf.SourceTableName = strTableName
                End If
               
                db.TableDefs.Append tdf                                         'append the new tdf to the collection, under it's temporary name
                DoCmd.DeleteObject acTable, strTableName                        'if the append succeeds, delete the old tdf
                DoCmd.Rename strTableName, acTable, strTmpNewTableObjName       'rename the new tdf object to its regular table name
                'End new code for Oracle
               
                varX = SysCmd(acSysCmdUpdateMeter, intI)
            End If
        Next intI
        varX = SysCmd(acSysCmdRemoveMeter)
       
        'Change connect strings for queries that have them (pass-throughs)
        varX = SysCmd(acSysCmdInitMeter, "Reattaching Pass-Through Queries", db.QueryDefs.Count)
        For intI = 0 To db.QueryDefs.Count - 1
            Set qdf = db.QueryDefs(intI)
            If qdf.type = dbQSQLPassThrough Then
                qdf.Connect = strConnection
                varX = SysCmd(acSysCmdUpdateMeter, intI)
            End If
            qdf.ODBCTimeout = 60    'set ODBC timeout for all querys to 60 seconds
        Next intI
        varX = SysCmd(acSysCmdRemoveMeter)
       
        'Record the "current" connect string
        DoCmd.SetWarnings False
       
        DoCmd.RunSQL "DELETE connect_current.* FROM connect_current;"
       
        strSql = "          INSERT INTO connect_current ( server_name, connectstr )"
        strSql = strSql & "      SELECT connect_strings.server_name, connect_strings.connectstr"
        strSql = strSql & "        FROM connect_strings"
        strSql = strSql & "       WHERE connect_strings.server_name = '" & trim(strDataSource) & "';"
        DoCmd.RunSQL strSql
       
        DoCmd.SetWarnings True
    End If

End Sub

Private Function md_ParseConnectString(ByVal strConnect As String, ByVal strParamName As String) As String

    Dim intStartPosn As Integer
    Dim intEndPosn As Integer
   
    intStartPosn = InStr(strConnect, strParamName & "=") + Len(strParamName) + 1
    intEndPosn = InStr(intStartPosn, strConnect, ";") - 1
    md_ParseConnectString = trim(Mid(strConnect, intStartPosn, intEndPosn - intStartPosn + 1))

End Function



0

Featured Post

Enterprise Mobility and BYOD For Dummies

Like “For Dummies” books, you can read this in whatever order you choose and learn about mobility and BYOD; and how to put a competitive mobile infrastructure in place. Developed for SMBs and large enterprises alike, you will find helpful use cases, planning, and implementation.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The Windows Phone Theme Colours is a tight, powerful, and well balanced palette. This tiny Access application makes it a snap to select and pick a value. And it doubles as an intro to implementing WithEvents, one of Access' hidden gems.
Code that checks the QuickBooks schema table for non-updateable fields and then disables those controls on a form so users don't try to update them.
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…
Suggested Courses

770 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question