Réattacher les liens
Rafraîchissement automatique des liaisons des tables attachées.
Exécuter par exemple la fonction fCheckLinks depuis une Macro nommée Autoexec.
(En réseau local multi-postes, cette méthode qui exploite une erreur d'ouverture de recordset s'avère bien plus rapide que la lecture de la propriété .Connect de l'objet TblDef)
N'oubliez pas la référence DAO
Option Compare Database
Option Explicit
Dim nbTbl As Long
Dim idx As Long
Dim dbs As DAO.Database
Dim TblDef As DAO.TableDef
Function fCheckLinks()
Dim rst As DAO.Recordset
Set dbs = CurrentDb()
On Error Resume Next
nbTbl = dbs.TableDefs.Count
For idx = 0 To nbTbl - 1
Set TblDef = dbs.TableDefs(idx)
If TblDef.Attributes = dbAttachedTable Then
Set rst = dbs.OpenRecordset(TblDef.Name)
End If
Next idx
If err <> 0 Then
fRefreshLinks
End If
rst.Close
dbs.Close
Set rst = Nothing
Set dbs = Nothing
End Function
Sub fRefreshLinks()
Dim newpath As String
On Error Resume Next
newpath = fOpenFile("Choisir la Back-End", , False)
'N'oubliez pas la fonction fOpenFile
For idx = 0 To nbTbl - 1
Set TblDef = dbs.TableDefs(idx)
If TblDef.Connect <> "" Then
TblDef.Connect = ";DATABASE=" & newpath
TblDef.RefreshLink
End If
Next idx
If err = 0 Then
MsgBox "Bienvenue !", vbInformation + vbOKOnly, "Welcome !"
Exit Sub
Else
If MsgBox("Les Tables n'ont pas été trouvées " _
& "dans la base sélectionnée, voulez-vous essayer à nouveau ?", _
vbExclamation + vbYesNo, "Sélection non Valide") = vbNo Then
dbs.Close
Set dbs = Nothing
Set TblDef = Nothing
MsgBox "Au Revoir !", vbCritical + vbOKOnly, _
"Fermeture de l'application"
DoCmd.Quit
Else
dbs.Close
Set dbs = Nothing
Set TblDef = Nothing
Call fCheckLinks
End If
End If
End Sub
Dernière modification : 08/02/2010 01:29
Catégorie : - Tables
Page lue 11587 fois