Link tables

hello, I have some code for refreshing links. Which is
very slow.. how can I code a refreshing links function
only if the connection is broken?

The code I have now:

Function VerifyLink() As Boolean
On Error GoTo Err_Verify
'Verify connection information in linked tables
Dim db As DAO.Database
Dim tdx As DAO.TableDefs
Dim tdf As DAO.TableDef
Dim sConnect As String
Dim sConnectPrj As String
Dim sConnectTR As String
Dim SName As String
Dim sConnectBC As String

Set db = CurrentDb()
Set tdx = db.TableDefs
sConnect = ";DATABASE=I:\01\Drives\PIBDE General\Data
Bases\PersonnelInfo02_be.mdb"
sConnectPrj = ";DATABASE=I:\01\Drives\PIBDE General\Data
Bases\Projects02_be.mdb"
sConnectTR = ";DATABASE=I:\01\Drives\PIBDE General\Data
Bases\TimeRecording07_be.mdb"
sConnectBC = ";DATABASE=I:\01\Drives\PIBDE General\Data
Bases\Book_Database_be.mdb"
' Skip system tables
For Each tdf In tdx
With tdf
SName = .Name
If .Connect vbNullString Then
If Not (VBA.Left$(SName, 4)
= "MSys" Or VBA.Left$(SName, 1) = "~") Then
If (SName
= "tblListOfProjects") Then
.Connect =
sConnectPrj
ElseIf (SName
= "tblCTSAPLst" Or SName = "tblDevelopmentActivities" _

Or SName = "tblTRPrj") Then
.Connect =
sConnectTR
ElseIf (SName = "Book
Inventory" Or SName = "Category" _
Or SName
= "Lenguaje" Or SName = "Location" Or SName
= "tblBookRental") Then
.Connect =
sConnectBC
Else
.Connect = sConnect
End If
.RefreshLink
End If
End If
End With
Next
If Err.Number 0 Then
VerifyLink = False
Else
VerifyLink = True
End If
Salir_Fun:
On Error Resume Next
db.Close
Set tdf = Nothing
Set tdx = Nothing
Set db = Nothing
Exit Function
Err_Verify:
MsgBox "Error " & Err.Number & ": " &
Err.Description
Resume Salir_Fun
End Function

thx,
gr

Before you run that code, try to open a recordset on one of the linked
tables. If it works, you don't need to relink.

Another trick is to open the database before you relink:
Dim dbData As DAO.Database
Set dbData = OpenDatabase("I:\01\Drives\PIBDE General\Data
Bases\PersonnelInfo02_be.mdb"
'rest of the relinking code here.
dbData.Close
Set dbData = Nothing
You do not actually use this variable, but it forces Access to hold the
network connection open until the relinking is done, which is much faster
than allowing it to close and reopen between each relink.

--
Allen Browne - Microsoft MVP. Perth, Western Australia.
Tips for Access users - http://allenbrowne.com/tips.html
Reply to group, rather than allenbrowne at mvps dot org.
"gr" wrote in message
...
hello, I have some code for refreshing links. Which is
very slow.. how can I code a refreshing links function
only if the connection is broken?

The code I have now:

Function VerifyLink() As Boolean
On Error GoTo Err_Verify
'Verify connection information in linked tables
Dim db As DAO.Database
Dim tdx As DAO.TableDefs
Dim tdf As DAO.TableDef
Dim sConnect As String
Dim sConnectPrj As String
Dim sConnectTR As String
Dim SName As String
Dim sConnectBC As String

Set db = CurrentDb()
Set tdx = db.TableDefs
sConnect = ";DATABASE=I:\01\Drives\PIBDE General\Data
Bases\PersonnelInfo02_be.mdb"
sConnectPrj = ";DATABASE=I:\01\Drives\PIBDE General\Data
Bases\Projects02_be.mdb"
sConnectTR = ";DATABASE=I:\01\Drives\PIBDE General\Data
Bases\TimeRecording07_be.mdb"
sConnectBC = ";DATABASE=I:\01\Drives\PIBDE General\Data
Bases\Book_Database_be.mdb"
' Skip system tables
For Each tdf In tdx
With tdf
SName = .Name
If .Connect vbNullString Then
If Not (VBA.Left$(SName, 4)
= "MSys" Or VBA.Left$(SName, 1) = "~") Then
If (SName
= "tblListOfProjects") Then
.Connect =
sConnectPrj
ElseIf (SName
= "tblCTSAPLst" Or SName = "tblDevelopmentActivities" _

Or SName = "tblTRPrj") Then
.Connect =
sConnectTR
ElseIf (SName = "Book
Inventory" Or SName = "Category" _
Or SName
= "Lenguaje" Or SName = "Location" Or SName
= "tblBookRental") Then
.Connect =
sConnectBC
Else
.Connect = sConnect
End If
.RefreshLink
End If
End If
End With
Next
If Err.Number 0 Then
VerifyLink = False
Else
VerifyLink = True
End If
Salir_Fun:
On Error Resume Next
db.Close
Set tdf = Nothing
Set tdx = Nothing
Set db = Nothing
Exit Function
Err_Verify:
MsgBox "Error " & Err.Number & ": " &
Err.Description
Resume Salir_Fun
End Function

thx,
gr