RATTACHEMENT DE TABLE AUTOMATIQUE ACCESS

Public Function F_RattacheTable(szFichier As String) As Boolean
    F_RattacheTable = True
    Dim TableEnCours As TableDef
    Dim TableNouvel As TableDef
    Dim szLgnINI As String
    Set db = CurrentDb
    'ouverture du fichier ini
    Set obj = CreateObject("Scripting.FileSystemObject")
    szFichierIni = Application.CurrentProject.Path & "\" & szFichier
    ' si le fichier n'existe pas on le crée (premier passage)
    If Not obj.FileExists(szFichierIni) Then
        P_genTableIni (szFichierIni)
    Else
        Set objFichierINI = obj.OpenTextFile(szFichierIni, 1, 0)
        'boucle infinie jusqu'à la fin du fichier
        Do
            On Error Resume Next
            szLgnINI = objFichierINI.ReadLine
            ' pour gerer simplemement la fin du fichier
            If Err.Number > 0 Then
                Exit Do
            End If
            ' boucle sur la liste des tables présente
            bTopTrouve = False
            For Each TableEnCours In db.TableDefs
                'on vérifie que c'est la bonne table
                If TableEnCours.SourceTableName = Trim(Left(szLgnINI, InStr(1, szLgnINI, "=") - 1)) Then
                    'mise à jours du lien ssi il a changé
                    If TableEnCours.Connect <> Mid(szLgnINI, InStr(1, szLgnINI, "=") + 1) Then
                    		' on met à jour la liaison seulement si la base à connecté est accessible
                    		If obj.FileExists(Mid(szLgnINI, InStr(1, szLgnINI, "=") + 1)) The
                        	TableEnCours.Connect = Mid(szLgnINI, InStr(1, szLgnINI, "=") + 1)
                        	TableEnCours.RefreshLink
                        end if
                    End If
                    ' si a traité la bonne table on sort du next et on passe à la ligne suivante du fichier
                    bTopTrouve = True
                    Exit For
                End If
            Next
            ' si la table n'est pas présente dans la liste des tables on crée le lien
            If Not bTopTrouve Then
            	' on crée le lien seulement si la base est accessible
            	If obj.FileExists(Mid(szLgnINI, InStr(1, szLgnINI, "=") + 1)) The
                Set TableNouvel = db.CreateTableDef(Trim(Left(szLgnINI, InStr(1, szLgnINI, "=") - 1)))
                TableNouvel.Connect = Mid(szLgnINI, InStr(1, szLgnINI, "=") + 1)
                TableNouvel.RefreshLink
                TableNouvel.SourceTableName = Trim(Left(szLgnINI, InStr(1, szLgnINI, "=") - 1))
                TableNouvel.RefreshLink
                db.TableDefs.Append TableNouvel
              end if
            End If
        Loop
        objFichierINI.Close
        Set objFichierINI = Nothing
    End If

    ' fermeture des objets
    Set obj = Nothing
    Set db = Nothing
End Function

Public Sub P_genTableIni(szNewFichierIni As String)
    Dim TableEnCours As TableDef
    Dim szLgnINI As String
    Set db = CurrentDb
    'ouverture du fichier ini
    Set obj = CreateObject("Scripting.FileSystemObject")
    obj.CreateTextFile szNewFichierIni, True
    Set objfINI = obj.GetFile(szNewFichierIni)
    Set objWritINI = objfINI.openAsTextStream(8)

    ' récupération du paramétrage
    For Each TableEnCours In db.TableDefs
        If Len(TableEnCours.Connect) > 0 Then
            szLgnINI = TableEnCours.SourceTableName & "=" & TableEnCours.Connect
            objWritINI.WriteLine (szLgnINI)
        End If
    Next

    ' fermeture des objets
    objWritINI.Close
    Set objFichierINI = Nothing
    Set objfINI = Nothing
    Set obj = Nothing
    Set db = Nothing
End Sub