Rattachement de table automatique access

Soyez le premier à donner votre avis sur cette source.

Snippet vu 11 031 fois - Téléchargée 28 fois

Contenu du snippet

ce petit truc me permet de mettre à jour facilement le rattachement des tables d'une application access à partir d'un fichier ini (défini dans la fonction rattache table). C'est idéal quand on doit livrer une appli access et que l'environnement de dev n'est pas le même que l'environnement (ou les environnements) de production.
F_Rattache table est une fonction car cela me permet de l'appeller directement d'une macro ;-)

Source / Exemple :


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

Conclusion :


Au lancement,
- si le fichier ini n'existe pas, il est crée à partir des paramètres de liaison définie dans la base.
-Sinon, il en utilisera les paramètres pour mettre à jour (si besoin) le lien vers les bonnes bases.

La structure du fichier ini est la suivante :
NomDeLaTable=CheminDeLaTable

A voir également

Ajouter un commentaire

Commentaires

Messages postés
24
Date d'inscription
jeudi 6 mars 2003
Statut
Membre
Dernière intervention
20 novembre 2011

Nouvelle version avec utilisation d'une table pour stocké le rattachement

' rattache les tables à partir du fichier ini passé en paramètre
' le fichier contient les lignes avec ce format :
' NOMTABLE=Param_de_connection
Sub P_RattacheTable()
Dim TableEnCours As TableDef

Set db = CurrentDb
sql = "select * from TableAttache"
Set rsTblAttache = db.OpenRecordset(sql)
Do While Not rsTblAttache.EOF
For Each TableEnCours In db.TableDefs
'on vérifie que c'est la bonne table
If TableEnCours.SourceTableName = rsTblAttache.Fields("NomTableAttache") Then
'mise à jours du lien ssi il a changé
If TableEnCours.Connect <> rsTblAttache.Fields("LienTableAttache") Then
TableEnCours.Connect = rsTblAttache.Fields("LienTableAttache")
TableEnCours.RefreshLink
End If
Exit For
End If
Next
rsTblAttache.MoveNext
Loop
rsTblAttache.Close
Set rsTblAttache = Nothing
End Sub

Sub P_GenRattacheTable()
Dim TableEnCours As TableDef
Set db = CurrentDb
sql = "delete from TableAttache"
db.Execute (sql)
For Each TableEnCours In db.TableDefs
' uniquement si la table est attachée
If Len(TableEnCours.Connect) > 0 Then
sql = "insert into TableAttache (NomTableAttache, LienTableAttache) values ("
sql = sql & "'" & TableEnCours.SourceTableName & "',"
sql = sql & "'" & TableEnCours.Connect & "')"
db.Execute (sql)
End If
Next

End Sub
Messages postés
24
Date d'inscription
jeudi 6 mars 2003
Statut
Membre
Dernière intervention
20 novembre 2011

comme on dit, les choses les plus simples,
Je suis AE et j'ai aussi mon site perso ici : www.benke.fr
si tu as des besoins en dev, ben hésite pas
Messages postés
5
Date d'inscription
dimanche 27 août 2006
Statut
Membre
Dernière intervention
14 février 2010

Bon sang, j'utilise ta solution 1 (inélégante à souhait !)depuis 15 ans sans jamais avoir pensé à la seconde !!! D'autant que, si je me souviens bien, une création d'attache vers un back-end est quasi-instantanné, même si il est ouvert par d'autres utilisateurs.

Encore bravo pour cette suggestion !!!

Si je peux t'être d'une quelconque aide, n'hésite pas : tu peux voir mes applis en tapant cd.concept.online.fr dans ton navigateur.

A+
Messages postés
24
Date d'inscription
jeudi 6 mars 2003
Statut
Membre
Dernière intervention
20 novembre 2011

D'après ce que j'en sait ce n'est pas possible car access vérifie que la base est accessible (ce qui est assez logique, le contraire serait génant).
Une solution pas très élégante serait de reproduire ton environnement back-end en qualif et préparer ta connection ainsi.
Sinon tu n'attaches aucune table lors de ta configuration et tu laisses la fonction créer les attachements lors de son premier lancement chez ton client...
Messages postés
5
Date d'inscription
dimanche 27 août 2006
Statut
Membre
Dernière intervention
14 février 2010

Merci pour cette réponse rapide : je vois que j'ai affaire à un passionné !

Je vais reformuler plus simplement : comment créer une attache ou màj la propriété .Connect vers la table d'un fichier de base de données MS Access inaccessible ?

Je confirme que c'est hyper utile pour de multiples raisons.
Afficher les 16 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.