[AccessD] Updating Connect string for SQL Linked tables

rusty.hammond at cpiqpc.com rusty.hammond at cpiqpc.com
Fri Nov 4 10:23:51 CST 2005


I have a form (A97) that I designed to be able to change the parameters of a
connect string for any or all linked SQL tables in the current database that
the form resides in.  It seems to work once or twice on a database but then
quits working.  By quits working, I mean it goes through the code, looks
like it's working, but when you check the connect string (either through the
properties of the table, or looking at the msysobjects table), the connect
string is still the old one and the changes are not reflected in the
connection information on the SQL server.

I'm posting the code used to update the connection strings.  Any ideas would
be greatly appreciated.

Private Sub ChangeSQLODBCTables(strName As String, strOption As String,
strTo As String)
'***************************************************************************
********************
'*** This subroutine will refresh any tables that are linked to the Access
database via ODBC ***
'*** and will re-create the primary pseudo-index on the newly re-linked
table if necessary   ***
'*** Created by RustyH - 3/5/2003
***
'***************************************************************************
********************
    Dim db As Database
    Dim tdf As TableDef
    Dim tdfNew As TableDef
    Dim strConnect As String
    Dim strSourceTbl As String
    Dim strIndex As String
    Dim idx As Index
    Dim fld As Field
    Dim strFields As String
    Dim X As Integer
    Dim strSQL As String
    Dim fNewHasPrimary As Boolean
    Dim fOldHadPrimary
    Dim strStatus As String
       
    Set db = CurrentDb
    
    Set tdf = db.TableDefs(strName)
    strConnect = tdf.Connect
    fOldHadPrimary = False
    'Test if the connect string starts with ODBC - Linked access tables
don't show a link type
    'and local tables have an empty connect string ("")
    
    If Left(tdf.Connect, 5) = "ODBC;" Then
    
        strSourceTbl = tdf.SourceTableName
        strStatus = SysCmd(acSysCmdSetStatus, strName)
        For Each idx In tdf.Indexes
            'Search for a primary index on the table
            If idx.Primary = True Then
                fOldHadPrimary = True
                'Get the primary index name
                strIndex = idx.Name
                strFields = ""
                X = 0
                'Get the field list that makes up the primary index
                For Each fld In idx.Fields
                    If X = 0 Then
                        strFields = fld.Name
                    Else
                        strFields = strFields & "," & fld.Name
                    End If
                    X = X + 1
                Next fld
            End If
        Next idx
        'Refresh the link to the table
        If strTo = "" Then
            strConnect = ReplaceString_SQLTableOption(strConnect, ";" &
strOption & "=", "", False)
        Else
            strConnect = ReplaceString_SQLTableOption(strConnect, ";" &
strOption & "=", ";" & strOption & "=" & strTo & ";", False)
        End If
        If strConnect = "NO" Then
            Stop
            'Me.StatusMsg = Me.StatusMsg & vbCrLf & vbCrLf & strName & " is
not linked to the " & strFrom & " server"
        Else
            MsgBox "New connect: " & strConnect, vbOKOnly
            
            'tdf.Connect = strConnect
            'tdf.RefreshLink
            
            db.TableDefs.Delete strName
            
            Set tdfNew = db.CreateTableDef(strName)
            tdfNew.SourceTableName = strSourceTbl
            tdfNew.Connect = strConnect
            db.TableDefs.Append tdfNew
            tdfNew.RefreshLink
            'db.TableDefs.Refresh
            
            fNewHasPrimary = False
            For Each idx In tdfNew.Indexes
                'Determine if the newly refreshed table already has a
primary index
                If idx.Primary = True Then
                    fNewHasPrimary = True
                End If
            Next idx
            'If the newly refreshed linked ODBC table does NOT have a
primary index but it did before
            'the link was refreshed, then create a primary pseudo-index
            If fNewHasPrimary = False And fOldHadPrimary = True Then
                strSQL = "Create unique index " & strIndex & " on " &
tdfNew.Name & "(" & strFields & ")"
                DoCmd.RunSQL strSQL
            End If
            Me.StatusMsg = Me.StatusMsg & vbCrLf & strName & " done"
        End If
    End If
    
    db.Close
    Set db = Nothing
    strStatus = SysCmd(acSysCmdClearStatus)
    
End Sub


The following function is called by the main sub to create the new connect
string:


Private Function ReplaceString_SQLTableOption(strTextIn As String, strFind
As String, strReplace As String, fCaseSensitive As Boolean) As String
    ' Comments   : replaces a substring in a string with another
    ' Parameters : strTextIn - string to work on
    '              strFind - string to find
    '              strReplace - string to replace with
    '              fCaseSensitive - True for case sensitive search, False
for case-insensitive search
    ' Returns    : modified string
    '
    Dim strTmp As String
    Dim intPos As Integer
    Dim intLen As Integer
    Dim intCaseSensitive As Integer
    
    intCaseSensitive = IIf(fCaseSensitive, 2, 1)
    
    strTmp = strTextIn
    intPos = InStr(1, strTmp, strFind, intCaseSensitive)
    intLen = InStr(intPos + 1, strTmp, ";", intCaseSensitive) - intPos + 1
    If intPos > 0 Then
      Do While intPos > 0
        If strReplace <> "" Then
            strTmp = Left$(strTmp, intPos - 1) & strReplace & Mid$(strTmp,
intPos + intLen)
        Else
            strTmp = Left$(strTmp, intPos - 1) & Mid$(strTmp, intPos +
intLen - 1)
        End If
        intPos = InStr(intPos + intLen, strTmp, strFind, intCaseSensitive)
      Loop
    Else
      strTmp = "NO"
    End If
        
    If Right(strTmp, 1) = ";" Then strTmp = Left(strTmp, Len(strTmp) - 1)
        
    ReplaceString_SQLTableOption = strTmp
  
End Function


TIA!

Rusty Hammond
rusty.hammond at cpiqpc.com

**********************************************************************
WARNING: All e-mail sent to and from this address will be received,
scanned or otherwise recorded by the CPI Qualified Plan Consultants, Inc.
corporate e-mail system and is subject to archival, monitoring or review 
by, and/or disclosure to, someone other than the recipient.
**********************************************************************



More information about the AccessD mailing list