Liaison des tables (Dorsale Frontale)

Private Sub Form_Timer()
Dim db As DAO.Database, rs As DAO.Recordset
Dim strCheminBd As String
Dim Path As String

 Application.RefreshDatabaseWindow

'--- Permet d'acceder à la base en cours
     Set db = CurrentDb

'--- On détermine le Chemin + le nom de la base
     Path = ""
     Path = CurrentProject.Path
    strCheminBd = ""
    strCheminBd = Left$(Path, InStr(Path, "Base 1 Partie Applicative (Frontale)") - 1) & "Base 2 Partie Donnée (Dorsale)" & "\" & "AAAA_princip.mdb"
    
    If Not (GetCheminDBName("tbl Adhérents") = strCheminBd) Then

'--- Ouverture du recordset rs des tables à éxaminer...
     Set rs = db.OpenRecordset("tbl Attachees")
    
'--- Boucle sur les champs de la table
     While Not rs.EOF
           DetacheTbl rs![NomTablesAttachees]
          AttacheTbl rs![NomTablesAttachees], strCheminBd, rs![NomTablesAttachees]
    rs.MoveNext
    Wend
End If

Application.RefreshDatabaseWindow
   DoCmd.Close
   DoCmd.OpenForm ("frm Accueil général")
End Sub

Public Function AttacheTbl(ByVal strTable As String, strConnect As String, strSourceTable As String) As Boolean
' Attache une table à la base de données courante :
' strtable : nom local de la table à créer
' strconnect : localisation de la base où trouver la table à attacher
' strsourcetable : nom de la table dans la base source
 
On Error GoTo Err_Attachetbl
 
Dim dbTemp As Database
Dim tdfLinked As TableDef
Dim rsLinked As Recordset
Dim intTemp As Integer
Dim EndroitDorsale As String

EndroitDorsale = ";DATABASE=" & strConnect

Set dbTemp = CurrentDb
 
‘--- Crée un objet TableDef, définit ses propriétés Connect et SourceTableName
      Set tdfLinked = dbTemp.CreateTableDef(strTable)
      tdfLinked.Connect = EndroitDorsale
      tdfLinked.SourceTableName = strSourceTable
     dbTemp.TableDefs.Append tdfLinked
 
'--- table attachée ?
      If Table_existe(strTable) <> "no found" Then
            AttacheTbl = True
      Else
         AttacheTbl = False
    End If
Exit Function

Err_Attachetbl:
       AttacheTbl = False
      Exit Function
End Function

Public Function DetacheTbl(ByVal strTable As String) As Boolean
' Supprime l'attache d'une table dont le nom est passé en paramètre
 
'--- si la table n'existe pas, Ion va pas plus loin
      If Table_existe(strTable) = "no found" Then
          DetacheTbl = True
      Exit Function
     End If
 
On Error GoTo Err_DetacheTbl
 
Dim dbTemp As Database
Set dbTemp = CurrentDb
dbTemp.TableDefs.Delete strTable
Set dbTemp = Nothing
 
' --- table détachée ?
      If Table_existe(strTable) = "no found" Then
         DetacheTbl = True
Else
    DetacheTbl = False
End If
Exit Function
 
Err_DetacheTbl:
    Set dbTemp = Nothing
    DetacheTbl = False
    Exit Function
End Function
 
Public Function Table_existe(ByVal strTable As String)
' Est-ce que la table donnée existe dans la base courante ?
On Error GoTo err_Table_existe
Dim db As Database, tdfLoop As TableDef, strrep As String
Set db = CurrentDb
strrep = "no found"

For Each tdfLoop In db.TableDefs
    If UCase(tdfLoop.Name) = UCase(strTable) Then
        strrep = strTable
        Exit For
    End If
Next tdfLoop

Set tdfLoop = Nothing
Set db = Nothing
Table_existe = strrep
Exit Function
 
err_Table_existe:
Set tdfLoop = Nothing
Set db = Nothing
Table_existe = "error"
End Function

Function GetCheminDBName(tblName As String)
Dim db As Database, rs

On Error GoTo DBNameErr

'--- On récupère le chemin
     Set db = CurrentDb()
     rs = db.TableDefs(tblName).Connect
     GetCheminDBName = Right(rs, Len(rs) - (InStr(1, rs, "DATABASE=") + 8))
Exit Function

'Erreur
DBNameErr:

'--- Renvoi la fonction si erreur
     GetCheminDBName = 0
End Function