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 : Les mémos - Tables
Page lue 11170 fois