Refreshing linked tables - repeat for EVERY table

[Lewis Veale]

I have an Access 2000 front-end pointing at a SQL Server backend, with
around 80 linked tables and views. I frequently need to point the
front-end at different versions of the back-end, and achieve this by
relinking the tables and views to use a different DSN.

I use the Linked Table Manager > Select All > and tick the 'always
prompt for a new location' box, then click OK. It correctly pops up
the 'select data source' box, from which I chose the required DSN. I
enter the SQL Server connection info (it uses SQL Server
authentication, not Windows), and click OK. It then pops up the
'select data source' box AGAIN for the next table, and then for every
table/view I want to relink.

I know it used to only prompt for the required data source once, and
apply that to all the tables/views I needed to refresh, but now it
prompts for every table - which is VERY tedious!

I also have Access XP, and Access 2003 installed, but I am using
Access 2000 to attempt the refresh.

Any suggestions would be gratefully received.

Cheers, Lewis

[MGFoster]

Lewis Veale wrote:

I have an Access 2000 front-end pointing at a SQL Server backend, with
around 80 linked tables and views. I frequently need to point the
front-end at different versions of the back-end, and achieve this by
relinking the tables and views to use a different DSN.

I use the Linked Table Manager > Select All > and tick the 'always
prompt for a new location' box, then click OK. It correctly pops up
the 'select data source' box, from which I chose the required DSN. I
enter the SQL Server connection info (it uses SQL Server
authentication, not Windows), and click OK. It then pops up the
'select data source' box AGAIN for the next table, and then for every
table/view I want to relink.

I know it used to only prompt for the required data source once, and
apply that to all the tables/views I needed to refresh, but now it
prompts for every table - which is VERY tedious!

I also have Access XP, and Access 2003 installed, but I am using
Access 2000 to attempt the refresh.

Any suggestions would be gratefully received.

-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

I usually use this sub routine to relink tables:

Sub ReconnectSQLTable(strAccess As String, strSQL As String, _
strConnect As String)
' Purpose:
' Reconnect the indicated table.
' In:
' strAccess The name of the Access table.
' strSQL The name of the SQL table.
' strConnect The ODBC connect string.
' Out:
' Nothing returned
' Created:
' mgf 1dec1999
' Modified:
'

Dim db As Database
Set db = CurrentDb

On Error Resume Next

Dim str As String
str = db.TableDefs(strAccess).Name
If Err = 0 Then
' Get rid of any existing table before linking
' a new table w/ the same name.
On Error GoTo err_
db.TableDefs.Delete strAccess
End If
On Error GoTo err_
' Link & save connect info in table definition.
DoCmd.TransferDatabase acLink, "ODBC database", _
strConnect, acTable, strSQL, strAccess, False, True
Debug.Print "Connected: " & strAccess

exit_:
On Error Resume Next
db.Close
Set db = Nothing
Exit Sub

err_:
Beep
MsgBox "An error occurred while trying to reconnect table '" & _
strAccess & "@Error: " & Err.Description & "@", _
vbExclamation
Resume exit_

End Sub

Call it from another routine that has the name of all the linked tables:

Sub RelinkTables ()

Const CONNECT = "ODBC;Driver=SQL Server;Server=MyServer;" & _
"Database=MyDatabase;Trusted_Connection=Yes"

Dim strAccess(1 to 3) As String
Dim strSQL(1 to 3) As String
Dim i As Integer

strAccess(1) = "Accounts"
strAccess(2) = "Transactions"
strAccess(3) = "Customers"

strSQL(1) = "ACNTS"
strSQL(2) = "TXNS"
strSQL(3) = "CUSTS"

For i = 1 to 3
Call ReconnectSQLTable(strAccess(i), strSQL(i), Connect)
Next i

End Sub

--
MGFoster:::mgf00 <at> earthlink <decimal-point> net
Oakland, CA (USA)

-----BEGIN PGP SIGNATURE-----
Version: PGP for Personal Privacy 5.0
Charset: noconv

iQA/AwUBQizWCIechKqOuFEgEQLbpQCglrfIhDL9nOtZ7oXI3Sq8dG +C4lgAn3ln
sLzUFROHUNyz1HtseYjqWL2x
=lDyQ
-----END PGP SIGNATURE-----

[(Pete Cresswell)]

Per Lewis Veale:

I know it used to only prompt for the required data source once, and
apply that to all the tables/views I needed to refresh, but now it
prompts for every table - which is VERY tedious!

I also have Access XP, and Access 2003 installed, but I am using
Access 2000 to attempt the refresh.

Any suggestions would be gratefully received.

It's probably wretched excess, but here's what I do.
It's all driven by the fact that my apps load using a custom .INI file that's on
the LAN and shared by all users. Also, in my app I have a little table that
contains a row for each connection that needs TB refreshed.

A way to do it without the .INI file is to invoke a Common File Dialog and let
the user navigate to the back end on their own.

I've done it that way too, but prefer the .INI file approach bc it's 100%
transparent to the user.
-------------------------------------------------------------------------
Option Compare Database 'Use database order for string comparisons
Option Explicit

' This module contains code for re-connecting to the back-end tables per the
..INI file's
' "BackEndDataDbPath parameter found in the "[TretsProgramParms]" group.
'
' Without this parameter, we are lost and the app cannot run
'
' This module's sole interfact to the outside world is the Public routine
'ConnectRefresh()'
' Next available line# series = 5000

Const mModuleName = "basConnect"

Global Const gPathDbMainParmName_LAN = "PathDbMain_LAN"
Global Const gPathDbMainParmName_Local = "PathDbMain_Local"

Const mPathDbDataLoaderParmName = "PathDbDataLoader"
Const mPathDbIndexStageParmName = "PathDbIndexStage"

Const mConnectionFatal = 0
Const mConnectionOK = -1
Const mConnectionNeedsRefresh = -2

Const mMainTestTableName = "zstblRecordNumbers" 'The single table
we test to see if all the connections of this type are OK
Const mDataLoaderTestTableName = "dbo_STG_PSN_PROD"
Const mIndexStageTestTableName = "zstblIndexLoad_Indexes" 'The single table
we test to see if all the connections of this type are OK

Const mHomeDirParmName = "HomeDirOnLan"
Const mIniGroupName = "ProgramParms"

Private 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

Private Function connectionOK(ByVal theParameterName As String, ByVal theDbPath
As String, ByVal theTestTable As String) As Integer
2000 debugStackPush mModuleName & ": connectionOK"
2001 On Error GoTo connectionOK_err

' PURPOSE: To performs a 3-phase check on the DB/Table in question:
' 1) Checks to see if DB exists and can be opened as a MS Access DB
' 2) Checks to see if theTestTable can be opened in the DB
' 3) Checks the connection string for theTestTable to see if it
matches theDbPath
' ACCEPTS: - The name of the .INI file group/parameter that we look for to
tell us the path
' to the back end DB. Used only in case of trouble to notify
the user that the
' Group and/or parameter cannot be found in the .INI file.

2010 Dim thisWS As DAO.Workspace
Dim thisDB As DAO.Database
Dim remoteDB As DAO.Database
Dim myRS As DAO.Recordset
Dim myTD As TableDef

Dim skipLine As String
skipLine = Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10)

Const invalidPath = 3044
Const cannotOpenDB = 3049
Const cannotFindFile = 3024
Const objectNotFound = 3011321

2020 Set thisWS = DBEngine(0)
2040 Set thisDB = CurrentDb()
On Error Resume Next
Set remoteDB = thisWS.OpenDatabase(theDbPath)
If Err > 0 Then
MsgBox ".INI file " & SysCmd(SYSCMD_INIFILE) & " specifies '" &
theParameterName & "=" & theDbPath & "'." & skipLine & "That file was not found
or is not a MS Access database." & skipLine & "Application cannot be run." &
skipLine & "If everything else looks OK, check the database name parameters in
the .INI file.", 48, "Fatal Error"
Else
Set myRS = remoteDB.OpenRecordset(theTestTable, DB_OPEN_TABLE)
If Err > 0 Then
MsgBox "Table '" & theTestTable & "' not found in " & theDbPath &
"'." & skipLine & "Looks like that isn't the right database or is damaged." &
skipLine & "Application cannot be run." & skipLine & "If everything else looks
OK, check the database name parameters in the .INI file.", 48, "Fatal Error"
Else
2120 On Error GoTo connectionOK_err
2130 Set myTD = thisDB.TableDefs(theTestTable)
2140 If myTD.Connect = ";Database=" & theDbPath Then
2150 connectionOK = mConnectionOK
2160 Else
2170 connectionOK = mConnectionNeedsRefresh
2180 End If
2190 End If
2999 End If

connectionOK_xit:
debugStackPop
On Error Resume Next
Set myTD = Nothing
myRS.Close
Set myRS = Nothing
thisDB.Close
Set thisDB = Nothing
Set thisWS = Nothing
Exit Function

connectionOK_err:
bugAlert True, ""
Resume connectionOK_xit
End Function
Private Function connectionsRefreshMdb(ByVal theDbType As String, ByVal
theDbPath As String) As Integer
3000 debugStackPush mModuleName & ": connectionsRefreshMdb"
3001 On Error GoTo connectionsRefreshMdb_err

' PURPOSE: To refresh all the connections that point to the specified outside
JET database
' ACCEPTS: - The type of DB. "Main" in this case. Allowing for different
types lets us
' cover a situation where the app (not this one right now...) may
have several
' outside DBs that it connects to.
' - The UNC or complete DOS path to the DB we are trying to connect
to.

3020 Dim thisDB As DAO.Database
Dim myRS As DAO.Recordset
Dim myQuery As DAO.QueryDef
Dim myTD As TableDef
Dim i As Integer
Dim connectCount As Integer
Dim curTableName As String

3030 Set thisDB = CurrentDb
3031 Set myQuery = thisDB.QueryDefs("qryConnectionsRefresh")
3032 myQuery.Parameters("theDbType") = theDbType
3033 Set myRS = myQuery.OpenRecordset(dbOpenDynaset)

3035 If (myRS.BOF And myRS.EOF) Then
3036 connectionsRefreshMdb = True
3039 Else
3050 StatusSet "Re-Connecting '" & theDbType & "' tables to '" & theDbPath &
"'..."
3081 With myRS
3060 .MoveFirst
3070 Do Until .EOF
3071 curTableName = !tableName
3075 Set myTD = thisDB.TableDefs(!tableName)
3080 StatusSet "Re-Connecting " & !tableName
3082 .Edit
3083 !OldConnect = myTD.Connect
3084 .Update
3085 connectCount = connectCount + 1
3090 myTD.Connect = ";Database=" & theDbPath
3091 myTD.RefreshLink
'LogTime False, "reconncect " & curTableName
3092 .MoveNext
3300 Loop
3099 End With

3997 connectionsRefreshMdb = True
3998 StatusSet ""
3999 End If

connectionsRefreshMdb_xit:
debugStackPop
On Error Resume Next
Set myTD = Nothing
Set myQuery = Nothing
myRS.Close
Set myRS = Nothing
Set thisDB = Nothing
Exit Function

connectionsRefreshMdb_err:
3800 bugAlert True, "Current table name='" & curTableName & "'."

3810 If connectCount > 0 Then
3820 myRS.MoveFirst 'If we had a problem, try to restore
original connections.,,
3830 For i = 1 To connectCount
3840 Set myTD = thisDB.TableDefs(myRS!tableName)
3850 myTD.Connect = myRS!OldConnect
3860 myTD.RefreshLink
3870 myRS.MoveNext
3880 Next i
3890 End If

3899 Resume connectionsRefreshMdb_xit
End Function
Public Function ConnectRefresh() As Boolean
1000 debugStackPush mModuleName & ": ConnectRefresh"
1001 On Error GoTo ConnectRefresh_err

' PURPOSE: To check the connection to a sample table and, if the connection's
target DB cannot be found,
' reconnect all tables according to the path found in the .INI file.
' ACCEPTS: Name of the .INI file parm that specifies which back-end DB to
connect to.
' RETURNS: - True if connections didn't need refreshing or they were
refreshed successfully
' - False if connections could not be refreshed

1010 Dim dbPath As String
Dim pathStrategy25 As String

Dim gotFatal As Integer
Dim myResult As Integer
Dim myParmName As String

1015 DoCmd.Hourglass True

1100 StatusSet "Checking 'Main' connections..."
1101 dbPath = pathDbMainGet(myParmName)
1102 If Len(dbPath) = 0 Then
1103 gotFatal = True
1104 Else
1105 myResult = connectionOK("[" & mIniGroupName & "]-" & myParmName, dbPath,
mMainTestTableName)
1109 Select Case myResult
Case mConnectionFatal
1111 gotFatal = True
1119 Case mConnectionOK
'(do nothing)
1120 Case mConnectionNeedsRefresh
1121 gotFatal = Not connectionsRefreshMdb("Main", dbPath)
1129 End Select
1199 End If

1200 StatusSet "Checking 'DataLoader' connections..."
1201 dbPath = IniValue_Get("ProgramParms", mPathDbDataLoaderParmName)
1202 If Len(dbPath) = 0 Then
1203 gotFatal = True
1204 MsgBox "'" & mPathDbDataLoaderParmName & "' parm not found in '" &
SysCmd(acSysCmdIniFile) & "'.", vbCritical, "Application Cannot Be Run"
1205 Else
1206 myResult = connectionOK("[" & mIniGroupName & "]-" &
mPathDbDataLoaderParmName, dbPath, mDataLoaderTestTableName)
1209 Select Case myResult
Case mConnectionFatal
1211 gotFatal = True
1219 Case mConnectionOK
'(do nothing)
1220 Case mConnectionNeedsRefresh
1221 gotFatal = Not connectionsRefreshMdb("DataLoader", dbPath)
1229 End Select
1299 End If

1300 StatusSet "Checking 'IndexStage' connections..."
1301 dbPath = IniValue_Get("ProgramParms", mPathDbIndexStageParmName)
1302 If Len(dbPath) = 0 Then
1303 gotFatal = True
1304 MsgBox "'" & mPathDbIndexStageParmName & "' parm not found in '" &
SysCmd(acSysCmdIniFile) & "'.", vbCritical, "Application Cannot Be Run"
1305 Else
1306 myResult = connectionOK("[" & mIniGroupName & "]-" &
mPathDbIndexStageParmName, dbPath, mIndexStageTestTableName)
1309 Select Case myResult
Case mConnectionFatal
1311 gotFatal = True
1319 Case mConnectionOK
'(do nothing)
1320 Case mConnectionNeedsRefresh
1321 gotFatal = Not connectionsRefreshMdb("IndexLoad", dbPath)
1329 End Select
1399 End If
1990 If gotFatal = False Then
1991 ConnectRefresh = True
1992 End If

1997 StatusSet ""
1999 DoCmd.Hourglass False

ConnectRefresh_xit:
StatusSet ""
debugStackPop
On Error Resume Next
Exit Function

ConnectRefresh_err:
bugAlert True, ""
Resume ConnectRefresh_xit
End Function
Private Function homeDirOnLanGet() As String
debugStackPush mModuleName & ": homeDirOnLanGet"
On Error GoTo homeDirOnLanGet_err

' PURPOSE: To return the name of the back-end DB path as it was specified in the
..INI file
' and, if necessary, to load it from the .INI file

Static myPathDat As String

Dim l As Long
Dim ParmValue As String
Dim myIniPath As String

Const myNotFound = "{NotFound}"
Const myParameterName = mHomeDirParmName

If Len(myPathDat & "") = 0 Then
ParmValue = Space(255)
myIniPath = UCase$(SysCmd(acSysCmdIniFile))

l = GetPrivateProfileString(mIniGroupName, myParameterName, myNotFound,
ParmValue, 255, myIniPath)
If l And Left(ParmValue, 10) <> myNotFound Then
myPathDat = Left(ParmValue, l)
Else
MsgBox "'" & myParameterName & "' parameter not found in " & myIniPath &
vbCrLf & vbCrLf & "Application cannot be run." & vbCrLf & vbCrLf & "Please
notify your LAN manager.", vbCritical, "Fatal Error"
End If
End If

homeDirOnLanGet = myPathDat

homeDirOnLanGet_xit:
debugStackPop
On Error Resume Next
Exit Function

homeDirOnLanGet_err:
bugAlert True, ""
Resume homeDirOnLanGet_xit
End Function
Private Function pathDbMainGet(ByRef theParmName As String) As String
debugStackPush mModuleName & ": pathDbMainGet"
On Error GoTo pathDbMainGet_err

' PURPOSE: To return the name of the back-end DB path as it was specified in the
..INI file
' and, if necessary, to load it from the .INI file
' ACCEPTS: - Name of .INI file parm that specifies location of back-end DB
' RETURNS: Path to back-end DB
' SETS: Name of the .INI parm that specifies back end db

Dim l As Long
Dim ParmValue As String
Dim myIniPath As String
Dim myPathDat As String
Dim myParmName As String

Const myNotFound = "{NotFound}"

If LocalMode_Get = True Then
myParmName = gPathDbMainParmName_Local
Else
myParmName = gPathDbMainParmName_LAN
End If

ParmValue = Space(255)
myIniPath = UCase$(SysCmd(acSysCmdIniFile))

l = GetPrivateProfileString(mIniGroupName, myParmName, myNotFound, ParmValue,
255, myIniPath)
If l And Left(ParmValue, 10) <> myNotFound Then
myPathDat = Left(ParmValue, l)
Else
MsgBox "'" & myParmName & "' parameter not found in " & myIniPath & vbCrLf &
vbCrLf & "Application cannot be run." & vbCrLf & vbCrLf & "Please notify your
LAN manager", vbCritical, "Fatal Error"
End If

theParmName = myParmName
pathDbMainGet = myPathDat

pathDbMainGet_xit:
debugStackPop
On Error Resume Next
Exit Function

pathDbMainGet_err:
bugAlert True, ""
Resume pathDbMainGet_xit
End Function
-------------------------------------------------------------------------
--
PeteCresswell

[Jeff Smith]

Hi Pete

After having a look at your code, what are "debugStackPush" and
"debugStackPop"

Jeff

Private Function connectionOK(ByVal theParameterName As String, ByVal theDbPath As String, ByVal theTestTable As String) As Integer
2000 debugStackPush mModuleName & ": connectionOK" <=====
2001 On Error GoTo connectionOK_err
<snip>
connectionOK_xit:
debugStackPop <=====
On Error Resume Next
Set myTD = Nothing
myRS.Close
Set myRS = Nothing
thisDB.Close
Set thisDB = Nothing
Set thisWS = Nothing
Exit Function

[Lewis]

Thanks for all the replies - they are useful, and I'll probably resign
myself to uncommenting calls to these procedures (to refresh linked
tables) when I need to.

However, my fundamental question remains unanswered - why does Access
2000 prompt for the data source for every single table all of a sudden?

Cheers

Lewis Veale
lewisdotvealeatpdms.com
www.pdms.com

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

[MacDermott]

My experience is in linking Access backends, but I'd guess that something
similar would hold true for SQL Server.
If the Access tables I'm linking to are all located in the same mdb, I get
prompted once for the new location. If they're located in several mdbs, I
get prompted each time, until the remaining ones are all in the same mdb,
then the prompts cease.
If I need to link to several mdbs, I work around this by selecting all
the tables in a single mdb at a time.

One thing I now watch for is "left-over" tables, which I no longer use, and
so haven't bothered re-linking.
If they stay pointed to another backend, I get a bunch of prompts.

HTH

"Lewis" <lewisdotvealeatpdms.com> wrote in message
news:42**********@127.0.0.1...

Thanks for all the replies - they are useful, and I'll probably resign
myself to uncommenting calls to these procedures (to refresh linked
tables) when I need to.

However, my fundamental question remains unanswered - why does Access
2000 prompt for the data source for every single table all of a sudden?

Cheers

Lewis Veale
lewisdotvealeatpdms.com
www.pdms.com

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

[(Pete Cresswell)]

Per Jeff Smith:

After having a look at your code, what are "debugStackPush" and
"debugStackPop"

Routines I wrote myself to manage error trapping.

Here's my "Light" version....the real version pops a window and writes
information to a shared text file.
---------------------------------------------------
Option Compare Database 'Use database order for string comparisons
Option Explicit

' This module contains the routines used to trap/log errors and
' show the "bugAlert" screen. It is derived from my "real" bugAlert module,
' but stripped down to the bare essentials to the end of placating any code that
' calls the bugAlert routines (namely debugStackPush(), debugStackPop, and
bugAlert().

' Every procedure should have the following boilerplate in it to implement
' error trapping. What I do is create a .txt file with that boilerplate
' in it, with the single quotes removed. Then I just copy/paste from the
' .txt file each time I starting writing a routine. After pasting in the
' boilerplate, I just do a rename of "xxx" to the procedure name.

' Pete Cresswell
' 3/3/2003
' -----------------------------------------
' debugStackPush Me.Name & ": xxx"
' On Error GoTo xxx_err

'' PURPOSE: To

'xxx_xit:
' debugStackPop
' On Error Resume Next
' Exit Sub
'
'xxx_err:
' bugAlert True, ""
' Resume xxx_xit
' -----------------------------------------

Const mModuleName = "basBugAlert_Lite"
Const mDebugStackTotalSize = 52
Global gDebugStack(mDebugStackTotalSize)
Global Const gStackLimit = 50

Global gStackPointer As Integer

Sub bugAlert(ByVal theDisplaySwitch As Integer, ByVal theSupplementalMessage As
String)

' PURPOSE: To show information about the trapped error
' ACCEPTS: - A switch that the "real" version of bugAlert uses to decide how
large and detailed
' a screen to show
' - Optional message text that the calling routine might want to supply
for
' display with the error message
'
' NOTES: 1) The "real" version logs the error in a text file.

Dim myErrorLine As Long
Dim myErrorNumber As Long
Dim myErrorMessage As String
Dim myErrorLocation As String

myErrorLine = Erl 'Capture relevant info ASAP. Dunno why, but
intuitively it seems like a good idea.
myErrorNumber = Err
myErrorMessage = Error$
myErrorLocation = gDebugStack(gStackPointer)

MsgBox myErrorLocation & ", Line " & Format$(myErrorLine, "000000") & " " &
Format$(myErrorNumber, "0000") & ": " & myErrorMessage & vbCrLf &
theSupplementalMessage, vbCritical, "There's Trouble In River City!"

End Sub
Sub debugStackPop()
On Error GoTo debugStackPop_err

' PURPOSE: To pop the last procedure name off the top of the debug stack

Dim i As Integer

If gStackPointer <= gStackLimit Then
gDebugStack(gStackPointer) = ""
End If

gStackPointer = gStackPointer - 1

If gStackPointer < 0 Then
gStackPointer = 0
End If

debugStackPop_xit:
On Error Resume Next
Exit Sub

debugStackPop_err:
MsgBox "debugStackPop() failed. Error " & Str(Err) & ": " & Error$, 48, "Error
In Error Handler"
Resume debugStackPop_xit
End Sub
Sub debugStackPush(ByVal theProcedureName As String)
On Error GoTo debugStackPush_err

' PURPOSE: To push a procedure name into the debug stack
' ACCEPTS: The procedure name

Dim i As Integer

gStackPointer = gStackPointer + 1

If gStackPointer <= gStackLimit Then
gDebugStack(gStackPointer) = theProcedureName
Else
gDebugStack(gStackLimit + 2) = theProcedureName
End If

debugStackPush_xit:
On Error Resume Next
Exit Sub

debugStackPush_err:
MsgBox "debugStackPush() failed. Error " & Str(Err) & ": " & Error$, 48,
"Error In Error Handler"
Resume debugStackPush_err
End Sub
Sub zzTestBugAlert()
debugStackPush mModuleName & ": zzTestBugAlert"
On Error GoTo zzTestBugAlert_err

' PURPOSE: To supply a model for using the BugAlert routines and to demo the
routines
'
' NOTES: 1) Fire up a Debug window and type "zzTestBugAlert"

DoCmd.OpenForm "frmNon-Existant"

zzTestBugAlert_xit:
debugStackPop
On Error Resume Next
Exit Sub

zzTestBugAlert_err:
bugAlert False, "This is the supplemental text...."
Resume zzTestBugAlert_xit
End Sub
---------------------------------------------------
--
PeteCresswell