RefreshLinks

[primerov]

I have copied from this forum a function called RefreshLinks. It should relink the tables
in the path "C:\be\be.mdb ". I have made a button on the form and on the OnClick event
i have put the following
RereshLinks( "C:\be\be.mdb &quot

However nothing happens.If i deliberately delete the links in the database, then
after pressing the button the tables in the back end database with a path ( "C:\be\be.mdb &quot are not relinked. I am afraid i do not either understand the
nature of the function, or i do not use it properly. May i receive some information as to how should i use this function ?

The function i have copied and pasted from the Forum is the following :

Function refreshlinks(strFileName As String) As Boolean
Dim tdf As DAO.TableDef
On Error Resume Next
' Loop through all tables in database.
For Each tdf In CurrentDb.TableDefs
' If the Connect property is non-empty, the table is linked
If Len(tdf.Connect) > 0 Then
tdf.Connect = ";DATABASE=" & strFileName
Err.Clear
tdf.RefreshLink ' Re-link the table.
If Err Then
refreshlinks = False
Exit Function
End If
End If
Next tdf
Set tdf = Nothing
refreshlinks = True ' All links have been refreshed.
End Function

 

[beetee]

if you delete the links in the database, you have no TDF objects to 'refresh'.

in the case where you do want to link tables that are not already linked, you need to open the back end database, and link the tabledefs in that database to the tabledefs in your database.

This code is off the top of my head, needs testing, and should be stepped through, but it's a start...

Function RefreshLinks(strBeDbName As String) As Boolean
On Error GoTo RefreshLinksError
Dim BeDb As DAO.Database
Set BeDb = DBEngine.OpenDatabase(strBeDbName)

Dim BeTdf As DAO.TableDef
On Error Resume Next
' Loop through all tables in be database.
For Each BeTdf In BeDb.TableDefs
' skip system tables
If (BeTdf.Attributes And dbSystemObject) <> dbSystemObject Then
On Error Resume Next
Dim FeTdf As DAO.TableDef
Set FeTdf = Nothing
' check for tabledef in current database
Set FeTdf = CurrentDb.TableDefs(tdf.Name)
On Error GoTo RefreshLinksError
' there is no tabledef, create one and append
If FeTdf Is Nothing Then
FeTdf = New TableDef
FeTdf.Name = BeTdf.Name
FeTdf.Connect = &quot;;DATABASE=&quot; & strFileName
CurrentDb.TableDefs.Append FeTdf
Else
' simply refresh the link
FeTdf.Connect = &quot;;DATABASE=&quot; & strFileName
End If
End If
Next tdf
Set tdf = Nothing
RefreshLinks = True ' All links have been refreshed.
RefreshLinksExit:
Exit Function
RefreshLinksError:
Debug.Print Err.Number & &quot;, &quot; & Err.Description
Resume RefreshLinksExit
End Function