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.
**********************************************************************