Solved

Relink Access tables from code

Posted on 2002-07-11
2
1,355 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
2 Comments
 
LVL 8

Expert Comment

by:dovholuk
Comment Utility
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 300 total points
Comment Utility
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

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

Introduction When developing Access applications, often we need to know whether an object exists.  This article presents a quick and reliable routine to determine if an object exists without that object being opened. If you wanted to inspect/ite…
I originally created this report in Crystal Reports 2008 where there is an option to underlay sections. I initially came across the problem in Access Reports where I was unable to run my border lines down through the entire page as I was using the P…
Familiarize people with the process of utilizing SQL Server stored procedures from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Micr…
In Microsoft Access, learn the trick to repeating sub-report headings at the top of each page. The problem with sub-reports and headings: Add a dummy group to the sub report using the expression =1: Set the “Repeat Section” property of the dummy…

762 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

Need Help in Real-Time?

Connect with top rated Experts

7 Experts available now in Live!

Get 1:1 Help Now