[AccessD] relinking

Dan Waters dwaters at usinternet.com
Fri Aug 28 14:30:11 CDT 2009


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





More information about the AccessD mailing list