Do not refresh the links if the links don't need to be refreshed

[ricardusmaximus]

Thank you. I ended up modifying some code to reference a Table contained on the Front End of the Database that passes the Pathway of the Linked Table on start-up. I'm sure it could be done better. I would like to modify it to not refresh the links if the links don't need to be refreshed testing the users Front End links against a table that is populated after initial Start-Up (We are having issues with the Split Database not being as responsive when people are working remotely.

Here it is:

 Sub RelinkTablesToAccess()

    Dim rst As DAO.Recordset
    Dim intNumTables As Integer
    Dim varReturn As Variant
    Dim intI As Integer
    Dim tdf As TableDef
    Dim fd As Office.FileDialog
    Dim vrtSelectedItem As Variant
    Dim sFileName As String
    Dim tableName As String
    
    On Error Resume Next
    Set rst = CurrentDb.OpenRecordset("AcctExec", dbOpenDynaset)
    
    'check for failure - the link must be bad.
    If Err <> 0 Then
    
        'get the new location
       ' Set fd = Application.FileDialog(msoFileDialogFilePicker)
       ' fd.Title = "Please select the backend database"
       ' fd.Filters.Clear
       ' fd.Filters.Add "Access Databases", "*.mdb"
        
       ' If fd.Show = True Then
        '    For Each vrtSelectedItem In fd.SelectedItems
       '         sFileName = vrtSelectedItem
       '     Next
     '   End If
        
        'Rebuild the links.  Check for the number of tables first
        intNumTables = CurrentDb.TableDefs.Count
        varReturn = SysCmd(acSysCmdInitMeter, "Relinking tables", intNumTables)
        
        'Loop through all tables.  Reattach those with nonzero-length Connect strings
        intI = 0
        For Each tdf In CurrentDb.TableDefs
        
            'if connect is blank, it's not a linked table
            If Len(tdf.Connect) > 0 Then
            
                intI = intI + 1
                CurrentDb.TableDefs.Delete tdf.name
                
               tableName = tdf.name
               sFileName = Linked_Table_Approach(tableName)
               
               
               ' MsgBox "Table Name = " & tableName & " File Path = " & sFileName
                
                Set tdf = CurrentDb.CreateTableDef(tableName)
                tdf.Connect = ";DATABASE=" & sFileName
                tdf.SourceTableName = tableName
                tdf.RefreshLink
                CurrentDb.TableDefs.Append tdf
                
            End If
            
            'Don't do anything
            varReturn = SysCmd(acSysCmdUpdateMeter, intI)
            
        Next tdf
        
        'Don't do anything
        varReturn = SysCmd(acSysCmdRemoveMeter)
        
    End If
  
End Sub

'This code reads from a Table that has the list of Tables that need to be relinked and their respective Paths
Public Function Linked_Table_Approach(xTable_Name As String)

   Dim db As DAO.Database
   Dim rs As Recordset
   Dim strSQL As String
   Dim xPath As String
   Dim xFlag As Boolean

   xFlag = False
   xPath = ""

   Set db = CurrentDb

   strSQL = "SELECT * FROM [Linked Tables]"
   Set rs = db.OpenRecordset(strSQL)

   Do While (Not rs.EOF And Not xFlag)
        
        If xTable_Name = rs!Linked_Table Then
           xPath = rs!Absolute_Path
           xFlag = True
     
           Linked_Table_Approach = xPath
     
           rs.Close
           Set rs = Nothing
           db.Close

Linked_Table_Approach_Exit:
            Exit Function
     
        Else
     
           rs.MoveNext
     
        End If
   Loop

   rs.Close
   Set rs = Nothing
   db.Close
     
'Need to have something that returns a negative value
   Linked_Table_Approach = "Table not found"
     
End Function

[zmbd]

This thread was split from:
Relative Path Issues using Linked Tables in an MS Access DB

To help keep the Q&A organized... :)

[Seth Schrock]

What I do for this is to perform a dlookup() on a table and if there is an error, then I perform the relink.

[zmbd]

Here's how I've handled this in the past:

1) Open a record-set on a known linked table, try to move within the record set (move last/first) using error trapping to relink as needed.

This is messy, slow, and from a coding standpoint - I've moved to the concept of engineering out the errors to begin with, not relying on un-intentional errors for branching (now I do use the err.raise method for some things :); however, that's an intentional error).

Instead, I've slowly transitioned databases to

2) Use the table definition to return the connection string and then use the link contained therein with the DIR() function to check for the files existence - you can roll your own code; however, Allen has a very flexible version here: Allen Browne, FileExists() and FolderExists() functions

THIS IS AIR CODE!!!! It may or may not work as is and doesn't have any relinking code -- and I have three of the four children underfoot today - much easier in the lab (chuckle). :)

Sub pVerifyPathsLinkedTables()
Dim zdb As DAO.Database
Dim ztbls As DAO.TableDefs
Dim ztdf As DAO.TableDef
Dim zarry() As String
'
Set zdb = CurrentDb
Set ztbls = zdb.TableDefs
'
For Each ztdf In ztbls
    If ztdf.Attributes = dbAttachedTable Then
        Debug.Print ztdf.Name,
        zarry() = Split(ztdf.Connect, "=")
        If Not FileExists(zarry(1)) Then
'>> Insert your relinker code call here...
        End If
    End If
Next
'
If Not ztdf Is Nothing Then Set ztdf = Nothing
If Not ztbls Is Nothing Then Set ztbls = Nothing
If Not zdb Is Nothing Then Set zdb = Nothing
End Sub

I'll repost Allen Browne's code, verbatium from the above link as it is used in the first code block so that one doesn't have to jump links - with that said, one should visit Allen's site for the full explanation of the code:

Function FileExists(ByVal strFile As String, Optional bFindFolders As Boolean) As Boolean
    'Purpose:   Return True if the file exists, even if it is hidden.
    'Arguments: strFile: File name to look for. Current directory searched if no path included.
    '           bFindFolders. If strFile is a folder, FileExists() returns False unless this argument is True.
    'Note:      Does not look inside subdirectories for the file.
    'Author:    Allen Browne. http://allenbrowne.com June, 2006.
    Dim lngAttributes As Long

    'Include read-only files, hidden files, system files.
    lngAttributes = (vbReadOnly Or vbHidden Or vbSystem)

    If bFindFolders Then
        lngAttributes = (lngAttributes Or vbDirectory) 'Include folders as well.
    Else
        'Strip any trailing slash, so Dir does not look inside the folder.
        Do While Right$(strFile, 1) = "\"
            strFile = Left$(strFile, Len(strFile) - 1)
        Loop
    End If

>>> A few things about the code in post #1 - mind you, I haven't gone thru it with a "fine tooth comb" to get out all of the gremlins, these are just the ones that "talked to me" as I was reading thru the code:

Post 1 - Code Block 1:
Set a reference to your current database in the beginning as I have done in the above code. This is two fold, memory management and to ensure that you are referring to a single (and same) object.
Thus Code Block 1 insert at line 2ish
Dim db as DAO.Database

Thus Code Block 1 insert at line 13/14ish
Set db = CurrentDB

Thus Code Block 1 alter line 14ish
Set rst = db.OpenRecordse t("AcctExex", dbOpenDynaset)

Thus Code Block 1 alter line 32
intNumTables=db .tabledefs.coun t

Thus Code Block 1 alter line 37
For Each tdf In Db.TableDefs

Thus Code Block 1 alter line 34
Db.TableDefs.De lete tdf.name

Thus Code Block 1 alter line 55
Db.TableDefs.Ap pend tdf

At the end of Code Block 1 you need to release the objects,
If you Set it, release it, if you open it, close it .
see the end of the code within this post:

if not rst is nothing then
   rst.close
   set rst = nothing
end if
'
'we didn't open the DB objet thus just release it
if not db is nothing then set db = nothing

Code block two of post one
Line 40,41: I highly advise changing this to match the if not is nothing template as I used above for "rst." This avoids some errors, and, if you use proper error trapping you can use this construct as part of the return from error as cleanup

Line 42: DB was not "Opened" only set as an object. Closing this can result in corruption and other hassles as you are currently using the "current database" the object refers to. Instead: if not db is nothing then set db = nothing

And I'll risk the ire of the masses....
+ BACK UP - BACK UP - BACK UP
+ Never, Never, Never, Never, use the production database as the development database.
+ Always have a back up of the development database.
I usually start my day by making a copy of the current version of the development database and using that copy as my current day's development file... append the current date-time (file_YYYYMMDDH HMM). When I come back from lunch, I make a new copy as before. This way there's always a way to roll back or recover. I have really messed up files during development. -0
> I don't make as many copies of the development back-end; however, a few, I hate recreating table structures and retyping state names/abbreviations.. . of course, I have tables like that stored in other databases... but why re-import.