En poursuivant votre navigation sur ce site, vous acceptez l'utilisation de cookies pour vous proposer des contenus et services adaptés. Mentions légales.

Recherche

Recherche

Les mémos

Je débute...

Visites

 1263822 visiteurs

 2 visiteurs en ligne

Nous contacter

Contact

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

Catégorie : Les mémos - Tables
Page lue 11208 fois
Vous êtes ici :   Accueil » Réattacher les liens