Jim Lawrence
accessd at shaw.ca
Fri Aug 28 15:20:45 CDT 2009
Hi Dans:
Looks like a great chunk of code and should do everything I need. There are
a couple of things that I have questions about... it may be nothing but as a
key reference or numerious calls to these items have be made I am curious as
to whether there is any related/data structures code that may be required?
Functions missing:
readpsiparameter(), QuitFromLibrary() and DisplayPB()
Variables missing:
TempTablesPath
Tables missing:
ZZtblRefreshLinks, tblTTOpenItemsList, tblTT
Thanks gain.
Jim
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Dan Waters
Sent: Friday, August 28, 2009 12:30 PM
To: 'Access Developers discussion and problem solving'
Subject: Re: [AccessD] relinking
Hi Jim,
This is the code that I wrote for my use. The 'RelinkLibraryTables' and
'RelinkFrontEndTables' are called from a 'Startup' procedure in the
Library.mdb file, which is referenced by different customers' FE mdb files.
The library contains links to both mdb tables and to sql tables (same set of
tables), and the code will redefine the connect information for the correct
set of links, and will rename the links dynamically so the correct set of
links is used.
Good Luck!
Dan
--------------------------------------------------------------
Public Sub RelinkLibraryTables()
Dim stgBEPath As String
Dim stgTTPath As String
Dim tdf As DAO.TableDef
Dim tdfBE As DAO.TableDef
Dim tdfTT As DAO.TableDef
Dim dbs As Database
Dim stgMessage As String
'MlngStart = GetTickCount
'-- Get Actual TempTable paths
stgTTPath = TempTablesPath
'-- Get BE path
stgBEPath = ReadPSIParameter("SystemBEName")
If InStr(stgBEPath, "=") = 0 Then
'-- Full Path to MDB BE
stgBEPath = BEFullPath
End If
'-- Set tdf variables for LIB database
Set dbs = CodeDb
Set tdfBE = dbs.TableDefs("tblUserMessages")
Set tdfTT = dbs.TableDefs("tblTTOpenItemsList")
'-- Is relinking needed because paths are different?
If InStr(stgBEPath, "=") > 0 Then
'-- SQL Server BE
If tdfBE.Connect = stgBEPath And tdfTT.Connect = ";DATABASE=" &
stgTTPath Then
dbs.Close
Exit Sub
End If
Else
'-- MDB BE
If tdfBE.Connect = ";DATABASE=" & stgBEPath And tdfTT.Connect =
";DATABASE=" & stgTTPath Then
dbs.Close
Exit Sub
End If
End If
dbs.Close
'-- Attempt to relink
If RelinkingTables(stgBEPath, stgTTPath, "Library") = False Then
stgMessage = "Automatic Library Table Re-Linking was NOT
Successful." _
& vbNewLine & vbNewLine _
& "Table Name = " & MstgTableName _
& vbNewLine & vbNewLine _
& "Contact your System Owner (" & PersonJobRolePrimary("System
Owner") & "." _
& vbNewLine & vbNewLine _
& "The system will now shut down.@ @"
FormattedMsgBox GstgReminder, stgMessage, vbCritical + vbOKOnly,
"Re-Linking Not Successful"
Call QuitFromLibrary(False, True)
End If
'Call CollectStartupTimeInfo("RelinkLibraryTables")
Exit Sub
ErrEx.Bookmark = BOOKMARK_ONERROR
End Sub
Public Sub RelinkFrontEndTables()
'-- This will verify that the table links to the BE are correct. Only
one table is checked.
Dim tdfBE As DAO.TableDef
Dim tdfTT As DAO.TableDef
Dim stgMessage As String
Dim stgBEPath As String
Dim stgTTPath As String
Dim dbs As DAO.Database
'MlngStart = GetTickCount
'-- Get BE path
stgBEPath = ReadPSIParameter("SystemBEName")
If InStr(stgBEPath, "=") = 0 Then
'-- Full Path to MDB BE
stgBEPath = BEFullPath
End If
'-- Get TT path
stgTTPath = TempTablesPath
'-- Set tdf variables for FE Database
Set dbs = DBEngine(0)(0)
Set tdfBE = dbs.TableDefs("ZZtblRefreshLinks")
Set tdfTT = dbs.TableDefs("tblTTOpenItemsList")
'-- Is relinking needed because paths are different?
If InStr(stgBEPath, "=") > 0 Then
'-- SQL Server BE
If tdfBE.Connect = stgBEPath And tdfTT.Connect = ";DATABASE=" &
stgTTPath Then
dbs.Close
Exit Sub
End If
Else
'-- MDB BE
If tdfBE.Connect = ";DATABASE=" & stgBEPath And tdfTT.Connect =
";DATABASE=" & stgTTPath Then
dbs.Close
Exit Sub
End If
End If
dbs.Close
'-- Attempt to relink
If RelinkingTables(stgBEPath, stgTTPath, "Front End") = False Then
stgMessage = "Automatic Front End Table Re-Linking was NOT
Successful." _
& vbNewLine & vbNewLine _
& "Table Name = " & MstgTableName _
& vbNewLine & vbNewLine _
& "Contact your System Owner." _
& vbNewLine & vbNewLine _
& "The system will now shut down.@ @"
FormattedMsgBox GstgReminder, stgMessage, vbCritical + vbOKOnly,
"Re-Linking Not Successful"
Call QuitFromLibrary(False, True)
End If
'Call CollectStartupTimeInfo("RelinkFrontEndTables")
Exit Sub
ErrEx.Bookmark = BOOKMARK_ONERROR
End Sub
Private Function RelinkingTables(stgBEPath As String, stgTTPath As String,
stgName As String) As Boolean
Dim tdf As DAO.TableDef
Dim dbs As DAO.Database
Dim intStatus As Integer
Dim stgBEType As String
'-- Set correct database
If stgName = "Library" Then
Set dbs = CodeDb
Else
Set dbs = DBEngine(0)(0)
End If
'-- Set up progress bar
Call DisplayPB(0, dbs.TableDefs.Count, "Refreshing " & stgName & " Table
Links . . .")
intStatus = 0
If InStr(stgBEPath, "=") > 0 Then
stgBEType = "SQL"
Else
stgBEType = "JET"
End If
'-- Relink the table if it is a link
For Each tdf In dbs.TableDefs
'-- Links to MDB
If (tdf.Attributes And dbAttachedTable) Then
If Left$(tdf.Name, 5) = "tblTT" Then
'-- Temp Table Path
If tdf.Connect <> ";DATABASE=" & stgTTPath Then
tdf.Connect = ";DATABASE=" & stgTTPath
tdf.RefreshLink
End If
Else
If Left$(tdf.Name, 4) = "VTG_" Then
'-- This will link to Harvey Vogel MRP tables
If tdf.Connect <> ";DATABASE=" & Replace(stgBEPath,
"PSIHVMBE.mdb", "VantageData.mdb") Then
tdf.Connect = ";DATABASE=" & Replace(stgBEPath,
"PSIHVMBE.mdb", "VantageData.mdb")
tdf.RefreshLink
End If
Else
'-- BE Path
If tdf.Connect <> ";DATABASE=" & stgBEPath And stgBEType
= "JET" Then
tdf.Connect = ";DATABASE=" & stgBEPath
tdf.RefreshLink
End If
End If
End If
End If
'-- Links to SQL Server
If (tdf.Attributes And dbAttachedODBC) Then
'-- BE Path
If tdf.Connect <> stgBEPath And stgBEType = "SQL" Then
tdf.Connect = stgBEPath
tdf.RefreshLink
End If
End If
intStatus = intStatus + 1
Call DisplayPB(intStatus)
DoEvents
Next tdf
Call RenameLinks(stgBEType, stgName)
Call ClosePB
DBEngine(0)(0).TableDefs.Refresh
Application.RefreshDatabaseWindow
RelinkingTables = True
dbs.Close
Exit Function
ErrEx.Bookmark = BOOKMARK_ONERROR
End Function
Private Sub RenameLinks(stgBEType As String, stgName As String)
Dim blnRenamingIsNeeded As Boolean
Dim stgActivityTable As String
Dim tdf As DAO.TableDef
Dim dbs As DAO.Database
'-- Set correct database
If stgName = "Library" Then
Set dbs = CodeDb
Else
Set dbs = DBEngine(0)(0)
End If
For Each tdf In dbs.TableDefs
If (tdf.Name = "SS_tblActivity" And stgBEType = "SQL") Or (tdf.Name
= "AC_tblActivity" And stgBEType = "JET") Then
blnRenamingIsNeeded = True
Exit For
End If
Next tdf
dbs.Close
If blnRenamingIsNeeded = False Then
Exit Sub
End If
If stgBEType = "SQL" Then
Call RenameLinksJET(False, stgName)
Call RenameLinksSQL(True, stgName)
Else
Call RenameLinksSQL(False, stgName)
Call RenameLinksJET(True, stgName)
End If
Exit Sub
ErrEx.Bookmark = BOOKMARK_ONERROR
End Sub
Private Sub RenameLinksSQL(blnUseSQL As Boolean, stgName As String)
Dim tdf As DAO.TableDef
Dim dbs As DAO.Database
'-- Set correct database
If stgName = "Library" Then
Set dbs = CodeDb
Else
Set dbs = DBEngine(0)(0)
End If
For Each tdf In dbs.TableDefs
If (tdf.Attributes And dbAttachedODBC) Then
If blnUseSQL = True Then
If InStr(tdf.Name, "SS_") > 0 Then
tdf.Name = Mid(tdf.Name, 4)
End If
Else
If InStr(tdf.Name, "SS_") = 0 Then
tdf.Name = "SS_" & tdf.Name
End If
End If
End If
Next tdf
dbs.Close
Exit Sub
ErrEx.Bookmark = BOOKMARK_ONERROR
End Sub
Private Sub RenameLinksJET(blnUseJET As Boolean, stgName As String)
Dim tdf As DAO.TableDef
Dim dbs As DAO.Database
'-- Set correct database
If stgName = "Library" Then
Set dbs = CodeDb
Else
Set dbs = DBEngine(0)(0)
End If
For Each tdf In dbs.TableDefs
If (tdf.Attributes And dbAttachedTable) Then
If Left(tdf.Name, 5) <> "tblTT" Then
If blnUseJET = True Then
If InStr(tdf.Name, "AC_") > 0 Then
tdf.Name = Mid(tdf.Name, 4)
End If
Else
If InStr(tdf.Name, "AC_") = 0 Then
tdf.Name = "AC_" & tdf.Name
End If
End If
End If
End If
Next tdf
dbs.Close
Exit Sub
ErrEx.Bookmark = BOOKMARK_ONERROR
End Sub
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Jim Lawrence
Sent: Friday, August 28, 2009 2:12 PM
To: 'Access Developers discussion and problem solving'
Subject: [AccessD] relinking
Hi All:
I have not worked with the relinking of an Access module for a while...
probably close to 10 years.
I had a module at one time that would automatically link the FE and BE and
if the BE could not be found, in the last known or saved location, the user
could then browse and re-connect... This piece of code was put away
carefully and after many years... lost or forgotten.
If anyone has access to or knows where to find, the definitive Access FE/
Access BE 'relinking' code/module, would you pass it along.
It would be greatly appreciated.
Jim
--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com
--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com