IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)

Liaisons dynamiques pour bases fractionnées.

Méthode pour créer des liaisons dynamiques entre plusieurs applications ou comment remplacer le gestionnaire de tables liées.

15 commentaires Donner une note à l´article (5)

Article lu   fois.

L'auteur

Profil ProSite personnel

Liens sociaux

Viadeo Twitter Facebook Share on Google+   

I. Introduction

Un sujet récurrent revenant sur le forum concerne les liaisons entre bases.
Certes elles peuvent être gérées par le gestionnaire de tables liées intégré, mais si le fichier applicatif a été converti en .Mde ou .Accde, ce gestionnaire n'est pas accessible.
Cela pose un problème si les bases connectées sont déplacées ou renommées, ou si les tables liées sont supprimées ou renommées.
Dans ce cas l'application ne fonctionne plus, si une solution n'a pas été mise en place.

I-A. Objectifs

Notre objectif principal va donc être de créer un formulaire de liaison qui remplacera le gestionnaire intégré Access.

Nous devrons également pouvoir nous connecter à plusieurs bases simultanément.

Des procédures devront être effectuées au démarrage afin de détecter les éventuelles erreurs et ainsi les corriger.

Nous devrons pouvoir corriger, ajouter ou supprimer des liaisons.

Enfin nous en profiterons pour voir comment nous pouvons nous servir de cet outil pour avoir des liaisons dynamiques en fonction des besoins de l'application..

Cette méthode n'est bien sûr pas la seule. J'ai choisi de vous montrer celle-ci, car elle me semble relativement facile à comprendre et à mettre en place.
D'autres plus automatisées n'auront pas besoin de tables ou de formulaires spécifiques, mais seront peut-être moins visuelles et intuitives.

Il faut avoir quelques notions de programmation VBA pour comprendre cet article.
Afin de le rendre plus compréhensible, j'ai délibérément choisi de ne pas travailler sur tous les cas possibles de sécurité.
Je me suis limité à la sécurité par mot de passe fichier et en partant du principe que ce serait le même pour tous les fichiers sécurisés de l'application.
Dans le cas de protection par groupe de travail, il faudra étoffer le programme en s'inspirant de l'exemple suivant:
Lister les tables et les champs d'une base par Maxence HUBICHE.

I-B. Préalables

Je vous recommande avant de commencer, de bien comprendre le principe des bases fractionnées.
Pour cela je vous conseille vivement la lecture de l'excellent tutoriel de Morgan Billy Comment utiliser une application en mode multi-utilisateur.

Et comme toujours la lecture de la bible de la DAO Définition et manipulation de données avec DAO écrite par Tofalu.

I-C. Définition des fichiers qui nous serviront de tests

Pour étayer ces propos, nous allons imaginer une application fictive de relevés d'horaires de salariés, répartis sur trois sites différents.

Cette application comportera cinq fichiers.
- Un "TablesHoraires.mdb" comportant la table des effectifs, et les tables de relevés quotidiens de trois sites s'y référant:

  • Tbl_Effectifs
  • Tbl_RelevesSite1
  • Tbl_RelevesSite2
  • Tbl_RelevesSite3

- Un "TablesHorairesS.mdb" ayant les mêmes caractéristiques que le fichier précédent mais protégé par un mot de passe "test".

- Un "TablesSites.mdb", comprenant une seule table: Tbl_Sites. Cette table sera remplie avec les noms de nos 3 sites: Secteur_1, Secteur_2 et Secteur_3.

- Un "TablesSitesS.mdb" ayant les mêmes caractéristiques que le fichier précédent mais protégé par un mot de passe "test".

Ces quatre fichiers serviront de bases dorsales (Back End) à l'application.

- Enfin nous aurons notre fichier applicatif "Releves.mdb" destiné à saisir ou consulter les relevés horaires et à fournir des états récapitulatifs.
Ce sera notre base frontale (Front End), et c'est sur ce fichier que nous travaillerons.

Image non disponible

Comme vous pouvez le constater, notre frontale sera connectée à deux dorsales.
Pour les besoins de la démonstration, tous ces fichiers seront placés dans un répertoire : "c:\TestLiaisons".

Cette application fictive ne sert bien sûr qu'à étayer nos propos.
Il ne faut donc pas y chercher une quelconque cohérence dans une véritable gestion horaire.
Un lien permettant de télécharger la base exemple est disponible en fin d'article.

II. Mise en place du système de liaisons

Nous ne travaillons que sur notre fichier frontal "Releves.mdb".

II-A. Création de la table

Afin de stocker nos informations, nous allons créer une table "Tbl_Liens".
En mode création, voici cette table:

Image non disponible

Comme vous pouvez le constater, j'ai créé en plus des champs associés aux propriétés classiques d'une liaison, un champ "Permanent" de type Boolean.
Nous verrons dans la troisième partie de l'article, l'intérêt de cette notion.

II-B. Présentation du formulaire

Voici donc notre formulaire à sa première ouverture:

Image non disponible


Pour créer notre premier lien, nous saisissons le nom que nous voulons donner à notre table interne une fois attachée.
Nous pouvons à l'aide de la liste déroulante, voir les noms des tables déjà existantes à titre d'information.

Image non disponible


Nous cliquons sur le bouton de recherche de fichiers.

Image non disponible


Nous choisissons un fichier dans la fenêtre de recherche.

Image non disponible


Nous pouvons maintenant choisir dans le fichier sélectionné une table externe à l'aide de la liste déroulante.

Image non disponible


Nous continuons à saisir nos liaisons et nous validons.
Nous pouvons voir que toutes nos tables apparaissent bien dans la liste correspondante.

Image non disponible


Nous pouvons également constater la correspondance avec le gestionnaire d'attaches intégré d'Access.

Image non disponible


Supprimons deux tables dans notre formulaire et modifions le nom de la table interne de l'enregistrement 3 et validons.
La liste des tables est bien modifiée.

Image non disponible


En positionnant la souris sur la table correspondante, nous pouvons voir que le lien est bon.

Image non disponible


Maintenant modifions le chemin de la ligne1 (pour en faire un chemin erroné).
Mettons '\fichiers2\' au lieu de '\fichiers\'.

Image non disponible


Validons. Nous aurons un message d'erreur.

Image non disponible


Modifions de nouveau le chemin de la ligne1 (pour se mettre sur un fichier sécurisé).

Image non disponible


Validons. Nous aurons un autre message d'erreur.

Image non disponible


Qui nous ouvrira le formulaire de saisie de mot de passe.

Image non disponible

II-C. Code relatif aux liaisons

Nous pouvons maintenant passer au code proprement dit.
Pour cela, ouvrons l'éditeur VBA (Alt + F11) et insérons deux modules que nous nommerons par exemple.

  • Mdl_Utilitaires
  • Mdl_Liens
Image non disponible


Nous devons également nous assurer que la référence "Microsoft DAO 3.xx Object library" est bien cochée.

II-C-1. Module 'Mdl_Utilitaires'

Dans ce module, nous placerons des procédures et fonctions dont nous aurons besoin, mais que nous ne détaillerons pas.
En premier lieu il nous faut recopier le code de l'Api permettant de rechercher le chemin d'un fichier. Ce code est disponible dans la Faq: Ouvrir un fichier.

Code module Mdl_Utilitaires
Sélectionnez
Option Compare Database
Option Explicit

'Déclaration de l'API
Private Declare Sub PathStripPath Lib "shlwapi.dll" Alias "PathStripPathA" (ByVal pszPath As String)
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
                                         "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

'Structure du fichier
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

'Constantes
Private Const OFN_READONLY = &H1
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_SHOWHELP = &H10
Private Const OFN_ENABLEHOOK = &H20
Private Const OFN_ENABLETEMPLATE = &H40
Private Const OFN_ENABLETEMPLATEHANDLE = &H80
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_SHAREAWARE = &H4000
Private Const OFN_NOREADONLYRETURN = &H8000
Private Const OFN_NOTESTFILECREATE = &H10000

Private Const OFN_SHAREFALLTHROUGH = 2
Private Const OFN_SHARENOWARN = 1
Private Const OFN_SHAREWARN = 0

Public Function OuvrirUnFichier(Handle As Long, _
                                Titre As String, _
                                TypeRetour As Byte, _
                                Optional TitreFiltre As String, _
                                Optional TypeFichier As String, _
                                Optional RepParDefaut As String) As String
'OuvrirUnFichier est la fonction à utiliser dans votre formulaire pour ouvrir _
  la boîte de dialogue de sélection d'un fichier.
'Explication des paramètres
'Handle = le handle de la fenêtre (Me.Hwnd)
'Titre = Titre de la boîte de dialogue
'TypeRetour (Définit la valeur, de type String, renvoyée par la fonction)
'1 = Chemin complet + Nom du fichier
'2 = Nom fichier seulement
'TitreFiltre = Titre du filtre
'Exemple: Fichier Access
'N'utilisez pas cet argument si vous ne voulez spécifier aucun filtre
'TypeFichier = Extension du fichier (Sans le .)
'Exemple: mdb
'N'utilisez pas cet argument si vous ne voulez spécifier aucun filtre
'RepParDefaut = Répertoire d'ouverture par défaut
'Exemple: C:\windows\system32
'Si vous laissez l'argument vide, par défaut il se place dans le répertoire de votre application.

    Dim StructFile As OPENFILENAME
    Dim sFiltre As String

    'Construction du filtre en fonction des arguments spécifiés
    If Len(TitreFiltre) > 0 And Len(TypeFichier) > 0 Then
        sFiltre = TitreFiltre & " (" & TypeFichier & ")" & Chr$(0) & "*." & TypeFichier & Chr$(0)
    End If
    sFiltre = sFiltre & "Tous (*.*)" & Chr$(0) & "*.*" & Chr$(0)

    'Configuration de la boîte de dialogue
    With StructFile
        .lStructSize = Len(StructFile)    'Initialisation de la grosseur de la structure
        .hwndOwner = Handle    'Identification du handle de la fenêtre
        .lpstrFilter = sFiltre    'Application du filtre
        .lpstrFile = String$(254, vbNullChar)    'Initialisation du fichier '0' x 254
        .nMaxFile = 254    'Taille maximale du fichier
        .lpstrFileTitle = String$(254, vbNullChar)    'Initialisation du nom du fichier '0' x 254
        .nMaxFileTitle = 254  'Taille maximale du nom du fichier
        .lpstrTitle = Titre    'Titre de la boîte de dialogue
        .flags = OFN_HIDEREADONLY  'Option de la boite de dialogue
        If ((IsNull(RepParDefaut)) Or (RepParDefaut = "")) Then
            RepParDefaut = "C:\"
            PathStripPath (RepParDefaut)
            .lpstrInitialDir = RepParDefaut
        Else: .lpstrInitialDir = RepParDefaut
        End If
    End With

    If (GetOpenFileName(StructFile)) Then    'Si un fichier est sélectionné
        Select Case TypeRetour
        Case 1: OuvrirUnFichier = Trim$(Left(StructFile.lpstrFile, InStr(1, StructFile.lpstrFile, vbNullChar) - 1))
        Case 2: OuvrirUnFichier = Trim$(Left(StructFile.lpstrFileTitle, InStr(1, StructFile.lpstrFileTitle, vbNullChar) - 1))
        End Select
    End If

End Function

Si vous utilisez, Office 2010 64 bits. cette Api ne fonctionnera pas. Il vous faudra :
 - soit en modifier le code pour la rendre compatible en vous aidant de l'article de Thierry GASPERMENT: Développer avec Office 64 bits. en particulier le chapitre IV-A.
 - soit la remplacer par la boite de dialogue Office 'msoFileDialogFilePicker'. Plus de détails sur cette option dans la Faq ici.
   Dans ce cas n'oubliez pas de cocher la référence "Microsoft Office xx.0 Object library" correspondant à votre version Office.


Puis nous placerons une fonction permettant de tester si une table existe.

Code module Mdl_Utilitaires
Sélectionnez
Public Function TestTblExist(StrTblName As String) As Boolean
'---------------------------------------------------------------------------------------
'Fonction de contrôle de l'existence d'une table
'---------------------------------------------------------------------------------------
    Dim oTbl As DAO.TableDef
    Dim oDb As DAO.Database

    On Error GoTo Fin

    TestTblExist = False          'La fonction renvoie la valeur False.
    Set oDb = CurrentDb
    For Each oTbl In oDb.TableDefs
        If oTbl.Name = StrTblName Then
            TestTblExist = True   'La fonction renvoie la valeur True.
            Exit For
        End If
    Next

Fin:
    If Err.Number <> 0 Then
        MsgBox "Erreur TestTblExist  " & Err.Number & ".  " & Err.Description
        TestTblExist = False      'La fonction renvoie la valeur False.
    End If

    oDb.Close
    Set oDb = Nothing

End Function


Nous continuons en ajoutant une fonction permettant de tester si une requête existe.

Code module Mdl_Utilitaires
Sélectionnez
Public Function TestQryExist(StrQryName As String) As Boolean
'---------------------------------------------------------------------------------------
'Fonction de contrôle de l'existence d'une requête
'---------------------------------------------------------------------------------------
    Dim oDb As DAO.Database
    Dim oQdf As DAO.QueryDef

    On Error GoTo Fin

    TestQryExist = False           'La fonction renvoie la valeur False.
    Set oDb = CurrentDb
    Set oQdf = oDb.QueryDefs(StrQryName)
    TestQryExist = True            'La fonction renvoie la valeur True.

Fin:
    If Err.Number <> 0 Then
        MsgBox "Erreur TestQryExist  " & Err.Number & ".  " & Err.Description
        TestQryExist = False       'La fonction renvoie la valeur False.
    End If

    oDb.Close
    Set oDb = Nothing
    Set oQdf = Nothing

End Function


Nous mettons également une procédure permettant de créer une requête.

Code module Mdl_Utilitaires
Sélectionnez
Public Sub Crea_Req(StrNameQry As String, StrSql As String)
'---------------------------------------------------------------------------------------
'Procédure de création de requête
'---------------------------------------------------------------------------------------

    On Error GoTo Fin
    Dim qdef As DAO.QueryDef
    Dim oDb As DAO.Database

    Set oDb = CurrentDb()

    If TestQryExist(StrNameQry) Then                      'Teste l'existence de la requête.
        oDb.QueryDefs.Delete StrNameQry                   'La supprime si elle existe.
    End If

    Set qdef = oDb.CreateQueryDef(StrNameQry, StrSql)     'Crée la requête.

Fin:
    If Err.Number <> 0 Then
        MsgBox "Erreur 'création requête'  " & Err.Number & ".  " & Err.Description
    End If

    qdef.Close
    oDb.Close
    Set oDb = Nothing
    Set qdef = Nothing

End Sub

II-C-2. Module 'Mdl_Liens'

Nous allons maintenant nous occuper du module dans lequel nous placerons les procédures et fonctions consacrées aux liaisons.
Nous commencerons par placer une variable publique qui permettra de stocker le mot de passe en cas de sécurité fichier.

déclarations dans le module Mdl_Utilitaires
Sélectionnez
Option Compare Database
Option Explicit
Public strPassword As String 'variable publique en cas de sécurité par mot de passe.
II-C-2-a. Procédure de suppression de toutes les liaisons.

Cette procédure nous sera nécessaire quand nous voudrons valider les modifications faites dans le formulaire de liaison.

Code procédure DeleteAllLinks
Sélectionnez
Public Sub DeleteAllLinks()
'---------------------------------------------------------------------------------------
'Procédure de suppression de tous les liens
'---------------------------------------------------------------------------------------
    Dim oDb As DAO.Database
    Dim oTbl As DAO.TableDef

    On Error GoTo Fin

    Set oDb = CurrentDb

    'Nous créons une boucle sur toutes les tables internes du fichier.
    For Each oTbl In oDb.TableDefs
        'Nous déterminons toutes les tables qui sont attachées en excluant les tables systèmes
        If oTbl.Attributes = dbAttachedTable And Not oTbl.Attributes = dbSystemObject Then
            'Et nous les supprimons.
            DoCmd.DeleteObject acTable, oTbl.Name
        End If
    Next oTbl

Fin:
    If Err.Number <> 0 Then
        MsgBox "Erreur 'DeleteAllLinks'  " & Err.Number & "  " & Err.Description  & vbCrLf & _
		, vbInformation, "Erreur suppression liens"
    End If

    oDb.Close
    Set oDb = Nothing
    Set oTbl = Nothing
End Sub
II-C-2-b. Procédure de suppression d'une liaison

Cette procédure nous permettra de supprimer une liaison précise définie dans un argument.

Code procédure DeleteLink
Sélectionnez
Public Sub DeleteLink(StrTableInt As String)
'---------------------------------------------------------------------------------------
' Procédure de suppression d'une table attachée.
'---------------------------------------------------------------------------------------
    Dim oDb As DAO.Database
    On Error GoTo Fin

    'Contrôle si la table existe: Si valeur False, on quitte la procédure.
    If TestTblExist(StrTableInt) = False Then
        Exit Sub
    End If
    'Si valeur True on supprime la table.
    Set oDb = CurrentDb
    oDb.TableDefs.Delete StrTableInt

Fin:

    If Err.Number <> 0 Then
        MsgBox "Erreur 'DeleteLink'  " & Err.Number & "  " & Err.Description
    End If

    oDb.Close
    Set oDb = Nothing
    Exit Sub

End Sub
II-C-2-c. Fonction de création d'une liaison

Cette fonction nous sera essentiellement nécessaire quand nous aurons besoin de créer des liaisons dynamiques.

Code fonction CreateLink
Sélectionnez
Public Function CreateLink(ByVal StrTableInt As String, StrPath As String, strTableExt As String) As Boolean
'---------------------------------------------------------------------------------------
'Ajoute une table liée dans la base en cours.
'   arguments:
'    strTableInt : Nom de la table interne à lier.
'    strPath :     Chemin de la base externe.
'    strTableExt : Nom de la table externe à lier.
'---------------------------------------------------------------------------------------
    Dim oDb As Database
    Dim oTbl As TableDef

    On Error GoTo Fin

    Set oDb = CurrentDb
    'Crée la définition de la table interne.
    Set oTbl = oDb.CreateTableDef(StrTableInt)
    'Se connecte au fichier externe.
    oTbl.Connect = "MS Access;pwd=" & strPassword & ";DATABASE=" & StrPath
    'Trouve la table externe demandée.
    oTbl.SourceTableName = strTableExt
    oDb.TableDefs.Append oTbl

    'Teste si la table existe.
    If TestTblExist(StrTableInt) = True Then
        CreateLink = True    'La fonction renvoie la valeur True.
    Else
        CreateLink = False   'La fonction renvoie la valeur False.
    End If

Fin:

    If Err.Number <> 0 Then
        CreateLink = False

        Select Case Err.Number
        Case 3024, 3044, 3078  'Erreur si base externe non trouvée.
            MsgBox "Le chemin de la table interne " & StrTableInt & " n'a pas été trouvé. & vbCrLf & _
			       "Veuillez vérifier le chemin d'accès. ", vbExclamation, "Erreur création liaison"
            DoCmd.OpenForm "Frm_Liens", acNormal
        Case 3011              'Erreur si table non trouvée dans la base externe.
            MsgBox "La table externe " & strTableExt & " n'a pas été trouvée dans la base mentionnée. & vbCrLf & _
			       "Veuillez vérifier vos paramètres. ", vbExclamation, "Erreur création liaison"
            DoCmd.OpenForm "Frm_Liens", acNormal
        Case 3031              'Erreur si liaison nécessite un mot de passe ou si celui donné est erroné.
            MsgBox "La table " & StrTableInt & " nécessite un mot de passe.", vbExclamation, "Mot de passe demandé"
            DoCmd.OpenForm "Frm_MotDePasse", acNormal, , , , , "AjoutLiens"
            Exit Function
        Case 3321              'Erreur si chemin d'accès non indiqué.
            MsgBox "Le chemin d'accès de la table " & StrTableInt & " n'est pas mentionné. ", vbExclamation, "Erreur création liaison"
            DoCmd.OpenForm "Frm_Liens", acNormal
        Case 3043              'Erreur si Access n'arrive pas à se connecter au réseau.
            MsgBox "Impossible de se connecter au réseau." & vbCrLf & _
                   "Veuillez contacter votre administrateur réseau.", vbCritical, "Erreur réseau"
        Case 3049, 3428        'Erreur si base externe corrompue.
            MsgBox "La base externe est endommagée." & vbCrLf & _
                   "Veuillez contacter l'administrateur de cette base.", vbCritical, "Base externe endommagée"
        Case Else              'Si autre erreur.
            MsgBox "Erreur 'CreateLink' " & Err.Number & "   " & Err.Description

        End Select

    End If

    oDb.Close
    Set oDb = Nothing
    Set oTbl = Nothing

End Function
II-C-2-d. Procédure de modification d'une liaison

Cette procédure permet de refaire une liaison sur une table externe passée en argument.

Code procédure ModifyLink
Sélectionnez
Public Sub ModifyLink(StrTblExt As String)
'---------------------------------------------------------------------------------------
'Modifie le lien pour une table externe mise en argument.
'---------------------------------------------------------------------------------------
    Dim StrSql As String
    Dim oDb As DAO.Database
    Dim oRst As DAO.Recordset

    On Error GoTo Fin

    Set oDb = CurrentDb
    'Nous choisissons dans la table des liens l'enregistrement correspondant au lien externe demandé.
    StrSql = "SELECT Tbl_Liens.Id_Lien, Tbl_Liens.TableInt, Tbl_Liens.Chemin, Tbl_Liens.TableExt " & _
             "FROM Tbl_Liens " & _
             "Where Tbl_Liens.TableExt  = " & Chr(34) & Replace(StrTblExt, Chr(34), Chr(34) & Chr(34)) & Chr(34)

    Set oRst = oDb.OpenRecordset(StrSql, dbOpenSnapshot)

    'Une fois l'enregistrement trouvé.
    If Not oRst.EOF Then
        'Nous supprimons la liaison sur la table interne choisie.
        Call DeleteLink(oRst.Fields(1))
        'Puis nous recréons la liaison avec les arguments correspondants.
        Call CreateLink(oRst.Fields(1), oRst.Fields(2), oRst.Fields(3))
        oDb.TableDefs.Refresh
    Else
        MsgBox "Il n'y a pas de table correspondant à votre demande"
        Exit Sub
    End If

Fin:

    If Err.Number <> 0 Then
        If Err.Number = 2580 Then  'Erreur si enregistrement correspondant au secteur inexistant dans la table des liaisons.
            MsgBox "La liaison demandée n'est pas répertoriée." & vbCrLf & _
                   "Veuillez vérifier qu'elle existe dans votre table des liaisons. ", vbCritical, "Liaison non répertoriée"
        Else    'Indique sur quel numéro d'enregistrement se situe l'erreur.
            MsgBox "Vous avez une erreur de connexion sur le lien N° " & oRst.Fields(0), vbCritical, "Erreur Liaison"
        End If
        'Ouvre le formulaire de liaisons.
        DoCmd.OpenForm "Frm_Liens", acNormal
    End If
    
    oRst.close
    oDb.Close
    Set oDb = Nothing
    Set oRst = Nothing

End Sub
II-C-2-e. Procédure de suppression des liens non permanents

Cette procédure sera lancée au démarrage pour supprimer tous les liens non permanents de la table de liaisons.

Code procédure DeleteNonPermanentLinks
Sélectionnez
Sub DeleteNonPermanentLinks()
'---------------------------------------------------------------------------------------
'Supprime tous les liens n'étant pas permanents dans la table de liaisons.
'---------------------------------------------------------------------------------------
    Dim oDb As DAO.Database
    Dim StrSql As String
    Dim oTbl As DAO.TableDef
    Dim Orst As DAO.Recordset
    Dim StrTblName As String

    On Error GoTo Fin

    Set oDb = CurrentDb()

    'Pour chaque table attachée non Système.
    For Each oTbl In oDb.TableDefs
        If oTbl.Attributes = dbAttachedTable And Not oTbl.Attributes = dbSystemObject Then
            'Nous vérifions qu'elle n'est pas permanente dans la table de liaison.
            StrSql = "SELECT T01.TableInt " & _
                     "FROM Tbl_Liens T01 " & _
                     "Where T01.Permanent  = True and T01.TableInt= " & Chr(34) & Replace(oTbl.Name, Chr(34), Chr(34) & Chr(34)) & Chr(34)
            Set Orst = oDb.OpenRecordset(StrSql, dbOpenSnapshot)
            'Si la vérification est négative
            If Orst.EOF Then
                'Nous supprimons la table attachée.
                DoCmd.DeleteObject acTable, oTbl.Name
            End If
        End If
    Next oTbl
    oDb.TableDefs.Refresh
Fin:
    If Err.Number <> 0 Then
        MsgBox "Erreur DeleteNonPermanentLinks  " & Err.Number & "   " & Err.Description
        Resume Next
    End If

    oRst.Close
    oDb.Close
    Set oRst = Nothing
    Set oDb = Nothing

End Sub
II-C-2-f. Fonction de création des liens permanents

Cette procédure sera lancée au démarrage pour créer tous les liens permanents de la table de liaisons.

Code fonction CreatePermanentLinks
Sélectionnez
Private Function CreatePermanentLinks() As Boolean
'---------------------------------------------------------------------------------------
'Crée les liens permanents de la table de liaisons s'ils n'existent pas
'---------------------------------------------------------------------------------------
    Dim oDb As DAO.Database
    Dim StrSql As String
    Dim oRst As DAO.Recordset
    Dim oRst2 As DAO.Recordset
    Dim StrTblName As String
    Dim oTbl As DAO.TableDef

    On Error GoTo Fin

    Set oDb = CurrentDb
    
    CreatePermanentLinks = True
    
    'Etablit la liste des tables permanentes.
    StrSql = "SELECT T01.Id_Lien, T01.TableInt, T01.Chemin, T01.TableExt " & _
             "FROM Tbl_Liens T01 " & _
             "Where T01.Permanent  = True; "

    Set oRst = oDb.OpenRecordset(StrSql, dbOpenSnapshot)

    While Not oRst.EOF
        StrTblName = Nz(oRst.Fields("TableInt"))    'Nom table interne.

        If TestTblExist(StrTblName) = False Then    'Si la table permanente n'existe pas.
            Set oTbl = oDb.CreateTableDef(StrTblName)
            'Se connecte à la base externe
            oTbl.Connect = "MS Access;pwd=" & strPassword & ";DATABASE=" & oRst.Fields("Chemin")
            'Crée la liaison
            oTbl.SourceTableName = oRst.Fields("TableExt")
            oDb.TableDefs.Append oTbl
        Else                            'Si la table permanente existe déjà, tente de l'ouvrir
                Set oRst2 = oDb.OpenRecordset(StrTblName)
                oRst2.Close
                Set oRst2 = Nothing        
		End If
        
        oRst.MoveNext
    Wend

Fin:
    If Err.Number <> 0 Then
        CreatePermanentLinks = False
        
        Select Case Err.Number
        Case 3031        'Erreur si un mot de passe est nécessaire pendant la tentative d'ouverture d'une des tables.
            DoCmd.OpenForm "Frm_MotDePasse", acNormal, , , , , "ControleLiens"
            DeleteLink (StrTblName) 'Supprime le lien éventuel existant pour prendre en compte le mot de passe
        Case 3043        'Erreur si Access n'arrive pas à se connecter au réseau.
            Select Case MsgBox("Impossible de se connecter au réseau." & vbCrLf & _
                               "Veuillez contacter l'administrateur réseau." & vbCrLf & _
                               "Voulez-vous malgré tout continuer?" _
                               , vbYesNo Or vbCritical Or vbDefaultButton1, "Base externe endommagée")
            Case vbYes
                DoCmd.OpenForm "Frm_Accueil", acNormal
            Case vbNo
                DoCmd.Quit
            End Select
        Case 3049, 3428  'Erreurs si base externe corrompue.
            Select Case MsgBox("La base externe est endommagée." & vbCrLf & _
                               "Veuillez contacter l'administrateur de cette base." & vbCrLf & _
                               "Voulez-vous malgré tout continuer?" _
                               , vbYesNo Or vbCritical Or vbDefaultButton1, "Base externe endommagée")
            Case vbYes
                DoCmd.OpenForm "Frm_Accueil", acNormal
            Case vbNo
                DoCmd.Quit
            End Select
        Case Else        'Erreurs nécessitant d'ouvrir le formulaire de liaisons ou de quitter.
            Select Case MsgBox("    Des liaisons sont défectueuses." _
                               & vbCrLf & "Cliquez sur Oui pour modifier vos paramètres. " _
                               , vbYesNo Or vbExclamation Or vbSystemModal Or vbDefaultButton1, "Lien Invalide")
            Case vbYes
                DoCmd.OpenForm "Frm_Liens", acNormal
            Case vbNo
                DoCmd.Quit
            End Select

        End Select

    End If

    oRst.Close
    oDb.Close
    Set oRst = Nothing
    Set oDb = Nothing
    Set oTbl = Nothing

End Function
II-C-2-g. Fonction de contrôle à l'ouverture du fichier

Cette fonction est importante, car elle va être lancée par une macro 'autoexec' au démarrage de l'application afin de contrôler la validité des liens.
Il faut bien en analyser la logique :

  • nous vérifions pour chaque table attachée, qu'elle n'est pas permanente dans notre table de liaisons ;
  • si ce n'est pas le cas, nous les supprimons ;
  • nous établissons à partir de notre table, la liste de tous les liens nécessaires (permanents) ;
  • nous vérifions qu'ils existent réellement ;
  • s'ils n'existent pas nous les créons ;
  • s'ils existent nous tentons une ouverture de la table pour voir s'ils sont valides et provoquer une erreur éventuelle.

Nous aurions pu être tentés pour simplifier, de supprimer en bloc toutes les tables liées afin de les recréer.
Mais en cas de sécurité par mot de passe, il faudrait saisir celui-ci à chaque ouverture du fichier.
En effet Access stocke les informations de liaisons, y compris les éventuels mots de passe.
Ce qui fait que si une liaison valide n'est pas supprimée, il n'y aura pas besoin de le saisir de nouveau.

L'ensemble de ces opérations va être effectué par l'appel de deux procédures existantes.

Code procédure CheckLink
Sélectionnez
Public Function CheckLinks()
'---------------------------------------------------------------------------------------
'Fonction de contrôle au démarrage de l'application
'---------------------------------------------------------------------------------------
    'Appelle la procédure de suppression des liens non permanents
    DeleteNonPermanentLinks
    DoEvents
    'Appelle la procédure de création des liens permanents
    If CreatePermanentLinks = False Then  'Si erreur quitte la procédure
    Exit Function
    DoEvents
    Else
    'Ouvre le formulaire d'accueil
    DoCmd.OpenForm "Frm_Accueil", acNormal
    End If

End Function
II-C-2-h. Procédure de mise à jour des liaisons

C'est cette fonction que nous lancerons avec le bouton "valider" de notre formulaire. Là aussi il faut bien analyser le processus :

  • nous commençons par supprimer toutes les tables attachées ;
  • nous établissons à partir de notre table, la liste de tous les liens nécessaires (permanents) ;
  • nous recréons les tables attachées avec les paramètres de notre table de liaisons.
Code fonction RefreshLink
Sélectionnez
Public Sub RefreshLinks()
'---------------------------------------------------------------------------------------
'Procédure lancée lors de la validation des liaisons dans le formulaire
'---------------------------------------------------------------------------------------
    Dim oDb As DAO.Database
    Dim oTbl As DAO.TableDef
    Dim oRst As DAO.Recordset
    Dim StrSql As String
    On Error GoTo Fin

    Set oDb = CurrentDb
    'On commence par supprimer toutes les relations existantes.
    For Each oTbl In oDb.TableDefs
        If oTbl.Attributes = dbAttachedTable And Not oTbl.Attributes = dbSystemObject Then
            DoCmd.DeleteObject acTable, oTbl.Name
        End If
    Next oTbl

    Set oTbl = Nothing

    'On établit la liste de toutes les tables permanentes demandées dans la table de liaisons.
    StrSql = "SELECT Tbl_Liens.Id_Lien, Tbl_Liens.TableInt, Tbl_Liens.Chemin, Tbl_Liens.TableExt " & _
             "FROM Tbl_Liens " & _
             "Where Tbl_Liens.Permanent = True ; "

    Set oRst = oDb.OpenRecordset(StrSql, dbOpenSnapshot)

    While Not oRst.EOF
        'Crée la table avec le nom de la table interne.
        Set oTbl = oDb.CreateTableDef(oRst.Fields("TableInt"))
        'Se connecte au fichier externe avec le chemin indiqué.
        oTbl.Connect = "MS Access;pwd=" & strPassword & ";DATABASE=" & oRst.Fields("Chemin")
        'Cherche la table externe indiquée.
        oTbl.SourceTableName = oRst.Fields("TableExt")
        'Met à jour.
        oDb.TableDefs.Append oTbl
        oRst.MoveNext
    Wend

    oDb.TableDefs.Refresh

Fin:
    If Err.Number <> 0 Then
        Select Case Err.Number

        Case 3031             'Erreur due à la demande de mot de passe ou au mot de passe non valide.
            MsgBox "Un mot de passe est demandé ou celui " & vbCrLf & _
                   "que vous avez saisi n'est pas correct.", vbExclamation, "Message sécurité"
            DoCmd.OpenForm "Frm_MotDePasse", acNormal, , , , , "RefreshLiens"
        Case 3024, 3044, 3078 'Erreurs si chemin d'accès non correct.
            MsgBox "La base externe de la liaison N° " & oRst.Fields(0) & " n'a pas été trouvée. " & vbCrLf & _
                   "Veuillez vérifier le chemin d'accès. ", vbCritical, "Erreur Chemin d'accès"
        Case 3011             'Erreur si table externe non trouvée dans la base mentionnée.
            MsgBox "La table externe " & oRst.Fields(3) & " de la liaison N° " & oRst.Fields(0) & " n'a pas été trouvée. " & vbCrLf & _
                   "Veuillez vérifier le nom de la table. ", vbCritical, "Table inexistante dans base mentionnée"
        Case 3321             'Erreur si chemin d'accès non indiqué.
            MsgBox "Le chemin d'accès de la base externe " & oRst.Fields(1) & " n'est pas mentionné. "
        Case 3043             'Erreur si Access n'arrive pas à se connecter au réseau.
            MsgBox "Impossible de se connecter au réseau." & vbCrLf & _
                   "Veuillez contacter votre administrateur réseau.", vbCritical, "Erreur réseau"
        Case 3049, 3428       'Erreur si base externe corrompue.
            MsgBox "La base externe est endommagée." & vbCrLf & _
                   "Veuillez contacter l'administrateur de cette base.", vbCritical, "Base Principale endommagée"
        Case Else             'Si autre erreur.
            MsgBox "Erreur 'RefreshLink' " & Err.Number & "   " & Err.Description

        End Select

    End If

    oRst.Close
    oDb.Close
    Set oDb = Nothing
    Set oRst = Nothing
    Set oTbl = Nothing

End Sub

II-D. Propriétés et codes relatifs au formulaire de liaison

Voici notre formulaire en mode création. Il s'agit d'un formulaire en mode continu, ayant comme source notre table "Tbl_Liens".

Image non disponible

Il se compose entre autre :

  • d'une zone de texte "Txt_IdLien" ayant comme ControlSource le champ "Id_Lien" ;
  • d'une zone de texte "Txt_CheminFichierExt" ayant comme ControlSource le champ "Chemin" ;
  • d'une zone de liste déroulante "Cbo_TableInt" ayant comme ControlSource le champ "TableInt" ;
  • d'une zone de liste déroulante "Cbo_TableExt" ayant comme ControlSource le champ "TableExt" ;
  • d'une case à cocher "Chk_Permanent" ayant comme ControlSource le champ "Permanent".
  • d'un bouton "Cmd_CheminFichier".
  • d'un bouton "Cmd_Valid".

Pour bien comprendre les évènements que nous allons devoir mettre en place, il est nécessaire de bien analyser le processus à effectuer lors d'un nouvel enregistrement ou d'une modification.

  • Nous saisissons le nom de la table interne. La ComboBox nous fournit à titre indicatif les noms de toutes les tables présentes dans la base.
  • A l'aide du bouton de recherche, nous sélectionnons la base sur laquelle nous connecter.
  • La comboBox 'Table externe' doit aller chercher dans cette base les noms des tables existantes.
  • Puis nous validons afin de créer ou supprimer les liaisons demandées.

Il est bien évident que toutes ces opérations vont demander un certain nombre de vérifications. En particulier :

  • vérifier lors de la saisie du nom d'une nouvelle table liée, qu'une table avec lien permanent ne porte pas déjà ce nom ;
  • vérifier que les chemins indiqués ne sont pas vides ou erronés ;
  • vérifier que le nom de la table externe demandée est valide et unique ;
  • vérifier s'il y a besoin ou non d'un mot de passe.

Nous allons ouvrir notre formulaire en mode création et procéder contrôle par contrôle.

II-D-1. ComboBox 'Cbo_TableInt'

Les propriétés principales de ce contrôle sont :

   - 'Source contrôle'       : TableInt
   - 'Nombre colonnes'      : 1
   - 'Limité à liste'           : Non
   - 'Sur réception focus': [Procédure événementielle]
   - 'Après MAJ'               : [Procédure événementielle]

Voici le code 'Sur réception focus' qui permettra de mettre la liste à jour.

Code Cbo_TableInt
Sélectionnez
Private Sub Cbo_TableInt_GotFocus()
'---------------------------------------------------------------------------------------
'Va permettre de mettre à jour la liste des tables internes existantes.
'---------------------------------------------------------------------------------------

    Dim oDb As DAO.Database
    Dim oTbl As DAO.TableDef

    On Error Resume Next
    Me.Recalc
    Set oDb = CurrentDb

    'Met le contenu de la ComboBox 'Cbo_TableInt' à blanc.
    Me.Cbo_TableInt.RowSource = ""
    'Crée une boucle sur la liste des tables non système et les ajoute à la ComboBox.
    For Each oTbl In oDb.TableDefs
        If (oTbl.Attributes And dbSystemObject) = 0 And Not InStr(1, oTbl.Name, "~TMPCLP") = 1 Then
            Me.Cbo_TableInt.RowSourceType = "Value List"
            Me.Cbo_TableInt.AddItem oTbl.Name
        End If
    Next oTbl

Fin:
    oDb.Close
    Set oDb = Nothing
    Set oTbl = Nothing

End Sub


Et voici le code correspondant à l'évènement 'Après mise à jour' qui permettra de contrôler la saisie.

Code Cbo_TableInt
Sélectionnez
Private Sub Cbo_TableInt_AfterUpdate()
'---------------------------------------------------------------------------------------
'Procédure destinée à savoir s'il existe déjà une table avec lien permanent ayant le même nom.
'---------------------------------------------------------------------------------------

    Dim oDb As DAO.Database
    Dim oRst As DAO.Recordset
    Dim StrSql As String
    Dim MaVar As String         'Variable nom table interne.
    Me.Refresh

    MaVar = Nz(Me.Cbo_TableInt.Value)
    Set oDb = CurrentDb

    'Compte le nombre d'enregistrements correspondant à la valeur de la variable.
    StrSql = "Select count(Tbl_Liens.TableInt) " & _
             "From Tbl_Liens " & _
             "Where Tbl_Liens.Permanent = True and Tbl_Liens.TableInt =" & Chr(34) & Replace(MaVar, Chr(34), Chr(34) & Chr(34)) & Chr(34)
    Set oRst = oDb.OpenRecordset(StrSql, dbOpenSnapshot)
    'S'il y a plus d'1 enregistrement on ne peut pas rendre ce lien permanent
    If Not oRst.EOF Then
        If oRst.Fields(0) > 1 Then
            MsgBox "Une table avec un lien permanent porte déjà ce nom.", vbExclamation, "Saisie non valide"
            Me.Cbo_TableInt = Null   'Remet à blanc.
        End If
    End If

Fin:
    oRst.Close
    oDb.Close
    Set oDb = Nothing
    Set oRst = Nothing

End Sub

II-D-2. Bouton 'Cmd_CheminFichier'

Ce bouton est destiné à ouvrir le gestionnaire de recherche de fichiers, et à alimenter ainsi la zone de texte 'Txt_CheminFichierExt'.

Code bouton 'Cmd_CheminFichier'
Sélectionnez
Private Sub Cmd_CheminFichier_Click()
'---------------------------------------------------------------------------------------
'Procédure permettant de sélectionner le chemin de la base externe
'---------------------------------------------------------------------------------------

    Dim StrPath As String           ' Variable chemin d'accès au fichier externe.
    Dim strTFileName() As String    ' Variable tableau chemin fichier table externe.
    Dim strFileName As String       ' Variable nom fichier table externe.
    Dim strTFolderName() As String  ' Variable tableau dossier fichier table externe.
    Dim strFolderName As String     ' Variable dossier table externe.

    If Len(Me.Txt_CheminFichierExt) > 0 Then    'Si un chemin existe déjà dans la table.
'Détermine le dossier par défaut correspondant au chemin déjà inscrit.
        strTFileName = Split(Me.Txt_CheminFichierExt.Value, "\")
        strFileName = strTFileName(UBound(strTFileName))
        strTFolderName = Split(Me.Txt_CheminFichierExt.Value, "\" & strFileName)
        strFolderName = strTFolderName(LBound(strTFolderName))

        'Ouvre la boite de dialogue de choix de fichier sur le dossier venant d'être défini.
        StrPath = _
        OuvrirUnFichier(Me.Hwnd, "Selectionner une base de données Access", 1, "Fichiers Access", "mdb;*.mde;*.accdb;*.accde", strFolderName)

    Else    'Ouvre la boite de dialogue de choix de fichier.
        StrPath = _
        OuvrirUnFichier(Me.Hwnd, "Selectionner une base de données Access", 1, "Fichiers Access", "mdb;*.mde;*.accdb;*.accde")

    End If

    'Vérifie qu'un fichier a bien été sélectionné.
    If Len(StrPath) > 0 Then
        Me.Txt_CheminFichierExt.Value = StrPath
    Else    'Si pas de sélection permet de refaire la recherche.
        Select Case MsgBox("Vous devez sélectionner un fichier.", vbOKCancel Or vbExclamation Or vbDefaultButton1, "Attention")
        Case vbOK
            StrPath = OuvrirUnFichier(Me.Hwnd, "Selectionner une base de données Access", 1, "Fichiers Access", "mdb;*.mde;*.accdb;*.accde")
        Case vbCancel
            Exit Sub
        End Select
    End If
    
End Sub

II-D-3. ComboBox 'Cbo_TableExt'

La mise à jour de cette liste va être conditionnée au choix du fichier externe sélectionné. Il va donc falloir créer une procédure permettant de remplir cette liste:

Code procédure 'ListTblExt'
Sélectionnez
Private Function ListTblExt(StrPath As String)
'---------------------------------------------------------------------------------------
'Procédure permettant de mettre à jour la liste déroulante des tables externes en fonction du chemin sélectionné.
'---------------------------------------------------------------------------------------
    Dim oDb As DAO.Database
    Dim oWk As DAO.Workspace
    Dim oTbl As DAO.TableDef

    On Error GoTo Fin

    'Si le chemin externe a bien été saisi.
    If Len(Txt_CheminFichierExt) > 0 Then
        Set oWk = Workspaces(0)
        'Ouvre la base de données externe.
        Set oDb = oWk.OpenDatabase(StrPath, False, False, "MS Access;PWD=" & strPassword)

        With Me
            'Vide la zone de liste déroulante.
            .Cbo_TableExt.RowSource = ""
            'Pour chaque table externe trouvée n'étant pas une table système et n'ayant pas un nom temporaire attribué par Access, ajoute le nom à la liste.
            For Each oTbl In oDb.TableDefs
                If (oTbl.Attributes And dbSystemObject) = 0 And Not InStr(1, oTbl.Name, "~TMPCLP") = 1 Then
                    .Cbo_TableExt.RowSourceType = "Value List"
                    .Cbo_TableExt.AddItem oTbl.Name
                End If
            Next oTbl
        End With
        'Si pas de table sélectionnée.
    ElseIf Len(StrPath) = 0 Then
        MsgBox "Vous devez sélectionner un fichier externe ", vbExclamation, "Saisie du fichier"
    End If

Fin:
    If Err.Number <> 0 Then
        Select Case Err.Number

        Case 3031             'Erreur si mot de passe demandé.
            DoCmd.OpenForm "Frm_MotDePasse", acNormal, , , , , "ListeExterne"
        Case 3024, 3044, 91   'Erreur empêchant la connexion.
            Call MsgBox("Impossible de se connecter à la base externe mentionnée." _
                        & vbCrLf & "Veuillez vérifier le chemin d'accès." _
                        , vbCritical, "Base externe non trouvée")
        Case Else             'Erreur autre.
            MsgBox "Erreur 'ListTblExt' " & Err.Number & ". Impossible de se connecter à la base de données. ", vbCritical, "Erreur"
        End Select

    End If

    oWk.Close
    Set oDb = Nothing
    Set oWk = Nothing
    Set oTbl = Nothing

End Function


Err_ListTblExt:
    Select Case Err.Number
    
    Case 3031             'Erreur si mot de passe demandé.
        DoCmd.OpenForm "Frm_MotDePasse", acNormal, , , , , "ListeExterne"
    Case 3024, 3044, 91   'Erreur empêchant la connexion.
        Call MsgBox("Impossible de se connecter à la base externe mentionnée." _
                    & vbCrLf & "Veuillez vérifier le chemin d'accès." _
                    , vbCritical, "Base externe non trouvée")
    Case Else             'Erreur autre.
        MsgBox "Erreur 'ListTblExt' " & Err.Number & ". Impossible de se connecter à la base de données. ", vbCritical, "Erreur"
    End Select
    
    Resume Fin

End Function

Les propriétés principales de ce contrôle sont :

   - 'Source contrôle' : TableExt
   - 'Nombre colonnes' : 1
   - 'Limité à liste' : Non
   - 'Sur réception focus' : [Procédure événementielle]
   - 'Après MAJ' : [Procédure événementielle]

Voici le code correspondant à l'évènement. 'Sur réception focus' :

Code 'Cbo_TableExt'
Sélectionnez
Public Sub Cbo_TableExt_GotFocus()
    
    'Vérifie qu'un chemin est bien saisi
    If IsNull(Me.Txt_CheminFichierExt) Then
        MsgBox "Il n'y a pas de base externe sélectionnée", vbExclamation, "Liste des tables non accessible"
        Me.Cbo_TableExt.RowSource = ""
    Else
        Call ListTblExt(Me.Txt_CheminFichierExt)
    End If

End Sub


Code de l'évènement 'Après mise à jour'.

Code 'Cbo_TableExt'
Sélectionnez
Private Sub Cbo_TableExt_AfterUpdate()
'---------------------------------------------------------------------------------------
'Procédure permettant de contrôler que dans la même base externe la table sélectionnée n'est pas déjà utilisée.
'---------------------------------------------------------------------------------------
    Dim oDb As DAO.Database
    Dim oRst As DAO.Recordset
    Dim StrSql As String
    Dim StrTblExt As String         'Variable nom table externe.
    Dim StrPath As String           'Variable chemin base externe
    Me.Refresh

    StrTblExt = Nz(Me.Cbo_TableExt.Value)
    StrPath = Nz(Me.Txt_CheminFichierExt.Value)
    Set oDb = CurrentDb

    'Compte le nombre d'enregistrements correspondant à la valeur de la variable pour la même base externe
    StrSql = "Select count(Tbl_Liens.TableExt) " & _
             "From Tbl_Liens " & _
             "Where Tbl_Liens.Chemin =" & Chr(34) & Replace(StrPath, Chr(34), Chr(34) & Chr(34)) & Chr(34) & " And Tbl_Liens.TableExt = " & Chr(34) & Replace(StrTblExt, Chr(34), Chr(34) & Chr(34)) & Chr(34)
    Set oRst = oDb.OpenRecordset(StrSql, dbOpenSnapshot)

    'S'il y a plus d'1 enregistrement on ne peut pas saisir cette valeur.
    If Not oRst.EOF Then
        If oRst.Fields(0) > 1 Then
            MsgBox "Vous avez déjà un lien pour cette table.", vbExclamation, "Saisie non valide"
            Me.Cbo_TableExt = Null    'Met à blanc.
        End If
    End If

Fin:
    oRst.Close
    oDb.Close
    Set oDb = Nothing
    Set oRst = Nothing

End Sub

II-D-4. Bouton 'Cmd_Valid'

Ce bouton va nous permettre de faire l'opération de mise à jour.

Code bouton 'Cmd_Valid'
Sélectionnez
Private Sub Cmd_Valid_Click()
'---------------------------------------------------------------------------------------
'Procédure permettant de valider tous les changements effectués dans le formulaire de liaison
'---------------------------------------------------------------------------------------
    On Error Resume Next
    'Nous rafraichissons les données.
    Me.Requery
    DoEvents
    'Nous lançons la procédure de mise à jour.
    Call RefreshLinks

End Sub

II-D-5. Case à cocher 'Permanent'

Cette procédure sur l'évènement 'Après mise à jour' de la case à cocher nous empêchera de mettre un lien permanent sur une table en ayant déjà un.
Vous en comprendrez mieux l'utilité, quand nous aurons abordé cette notion.

Code case à cocher 'Chk_Permanent'
Sélectionnez
Private Sub Chk_Permanent_AfterUpdate()
'---------------------------------------------------------------------------------------
'Procédure n'autorisant un lien permanent que si la table interne est unique.
'---------------------------------------------------------------------------------------

    Dim oDb As DAO.Database
    Dim oRst As DAO.Recordset
    Dim StrSql As String
    Dim MaVar As String                    'Variable nom de la table interne.

    Me.Refresh
    If Me.Chk_Permanent = True Then        'Si le lien est coché.
        MaVar = Nz(Me.Cbo_TableInt.Value)  'Attribue à la variable le nom de la ComboBox 'Cbo_TableInt'.
        Set oDb = CurrentDb

        'Compte le nombre d'enregistrements correspondant à la valeur de la variable.
        StrSql = "Select count(Tbl_Liens.TableInt) " & _
                 "From Tbl_Liens " & _
                 "Where Tbl_Liens.TableInt =" & Chr(34) & Replace(MaVar, Chr(34), Chr(34) & Chr(34)) & Chr(34)

        Set oRst = oDb.OpenRecordset(StrSql, dbOpenSnapshot)

        'S'il y a plus d'un enregistrement on ne peut pas rendre ce lien permanent.
        If Not oRst.EOF Then
            If oRst.Fields(0) > 1 Then
                Call MsgBox("Vous ne pouvez avoir un lien permanent que sur une table ayant un lien unique." & vbCrLf & _
                            "Veuillez le renommer ou renommer les tables ayant le même nom.", vbExclamation, "Saisie non valide")
                Me.Chk_Permanent = False   'Remet la chekBox à False.
            End If
        End If
Fin:
        oRst.Close
		oDb.Close
        Set oDb = Nothing
        Set oRst = Nothing
    End If

End Sub

II-D-6. Code relatif à la validation du mot de passe dans le formulaire 'Frm_MotDePasse'

Vous avez pu voir que la gestion des erreurs était importante, et que l'erreur 3031 revenait souvent.
Cette erreur est celle relevée quand il y a nécessité de saisir un mot de passe.
La gestion de cette erreur provoque l'ouverture d'un formulaire 'Frm_MotDePasse'.
Après saisie du mot de passe, la validation sur le bouton 'Cmd_Valid' provoque un évènement déterminant la procédure ou fonction qu'il faut relancer.

Code Cmd_Valid'
Sélectionnez
Private Sub Cmd_Valid_Click()
'---------------------------------------------------------------------------------------
' Attribue à la variable publique StrPassword le mot de passe saisi.
'---------------------------------------------------------------------------------------

    strPassword = Nz(Me.Txt_Password.Value)

    'Gère la sortie du formulaire en fonction de l'argument OpenArgs.
    If Me.OpenArgs = "ControleLiens" Then     'Si ouverture du formulaire au lancement de l'application.
        DoCmd.Close
        Call CheckLinks
    ElseIf Me.OpenArgs = "RefreshLiens" Then  'Si ouverture du formulaire lors de la validation de modifications.
        DoCmd.Close
        Call RefreshLinks
    ElseIf Me.OpenArgs = "ListeExterne" Then  'Si ouverture du formulaire lors de l'accès à la liste des tables.
        DoCmd.Close
        Form_Frm_Liens.SetFocus
        Form_Frm_Liens.Cbo_TableExt_GotFocus
    End If

End Sub

III. Notion de lien permanent

Nous avons évoqué ce sujet plusieurs fois dans les chapitres précédents. Il est temps de le développer.

III-A. Principe

Le principe en est simple. Nous ne mettons en lien 'permanent' que les liens dont nous aurons toujours besoin.
Et nous mettrons en lien 'non permanent' tous ceux qui ne seront peut-être pas utilisés (car utilisés par exemple dans un seul formulaire) ou dont nous voudrons que la table externe soit variable.

III-A-1. Explication sur notre application

Reprenons notre formulaire de liaisons rempli de façon classique, comme le serait le gestionnaire intégré.

Image non disponible

Il y bien autant de liaisons que de tables nécessaires au bon fonctionnement de l'application. Les noms des tables internes sont donc différents.
Et qui dit tables différentes, dit sources de requêtes, formulaires et états différents.

Maintenant modifions, dans notre exemple, nos données afin que les tables externes 'Tbl_Releves1', 'Tbl_Releves2' et 'Tbl_Releves3' soient non permanentes et validons.

Image non disponible

Les tables correspondantes ont bien disparu de notre liste des tables.
Nous pouvons maintenant corriger notre table de liaisons et mettre un nom de table unique 'Tbl_RelevesSite' à nos trois liens possibles.

Image non disponible

Et si nous avons une table attachée unique, cela veut dire que nous pouvons n'avoir qu'une seule source pour nos requêtes ou formulaires.
Il nous suffira d'appeler la ligne correspondante et de créer la liaison en fonction des besoins.

III-A-2. Possibilité supplémentaire

Imaginons que dans notre schéma applicatif les tables soient réparties de façon différente.

  • Tbl_Effectifs et Tlb_Sites à l'intérieur d'un fichier Paramètres.mdb
  • Tbl_RelevesSite1 à l'intérieur d'un fichier RelevesSite1.mdb
  • Tbl_RelevesSite2 à l'intérieur d'un fichier RelevesSite2.mdb
  • Tbl_RelevesSite3 à l'intérieur d'un fichier RelevesSite3.mdb

Notre table de liaisons sera donc remplie comme ceci:

Image non disponible


Au démarrage de l'application, nous n'aurons besoin de nous connecter que sur le fichier 'Paramètres', avec deux liaisons permanentes

Image non disponible


Si nous voulons travailler sur la table 'RelevesSite2', nous ajouterons la connexion et la liaison correspondante.

Image non disponible


Les autres dorsales ne sont donc pas connectées.
Si nous voulons maintenant travailler sur la table 'RelevesSite3', la liaison avec la table 'RelevesSite2' sera supprimée et une autre connexion sera établie.

IV. Exemple de mise en application avec notre schéma de base

Avant toute chose et pour que cela fonctionne il faut avoir une cohérence dans les appellations. Dans notre exemple :
au Secteur_1 correspondra la table 'Tbl_RelevesSite' à laquelle nous ajouterons le chiffre du secteur pour avoir le nom de la table externe 'Tbl_RelevesSite1'
au Secteur_2 correspondra la table 'Tbl_RelevesSite' à laquelle nous ajouterons le chiffre du secteur pour avoir le nom de la table externe 'Tbl_RelevesSite2'
au Secteur_3 correspondra la table 'Tbl_RelevesSite' à laquelle nous ajouterons le chiffre du secteur pour avoir le nom de la table externe 'Tbl_RelevesSite3'
Cela nous permettra de déterminer la table correspondant au secteur choisi.


Pour illustrer tout cela, sur le formulaire d'accueil de l'application, j'ai simulé trois possibilités :
  - pouvoir saisir des données dans un formulaire de saisie sur un des secteurs possibles ;
  - pouvoir éditer un état correspondant à ces mêmes relevés ;
  - pouvoir éditer un état récapitulatif de tous les secteurs.

Nous ne rentrerons pas dans tous les détails de la mise en application. Nous n'aborderons que ceux qui concernent les liaisons.

IV-A. Présentation

Nous avons donc notre formulaire d'accueil.

Image non disponible

1) Nous choisissons un site dans la liste déroulante correspondante.
Cette liste aura comme source notre table 'Tbl_Sites'

Image non disponible


Nous validons et nous arrivons sur le formulaire de saisie du site_2.

Image non disponible


Si nous choisissons Secteur_1 dans la liste des états et si nous validons nous aurons ceci.

Image non disponible


Si nous cliquons sur le bouton 'Etat global' nous aurons un état correspondant aux trois secteurs.

Image non disponible

IV-B. Mise en place

IV-B-1. Ouverture du formulaire de saisie

Ce code va être une illustration de la liaison dynamique, puisque suivant le secteur choisi dans la ComboBox, la connexion va être différente.

Code case à cocher 'Chk_Permanent'
Sélectionnez
Private Sub Cmd_Saisie_Click()
'---------------------------------------------------------------------------------------
'Procédure d'ouverture du formulaire de saisie
'---------------------------------------------------------------------------------------
    Dim StrSecteur() As String    'Variable tableau données zone déroulante Cbo_SiteSaisie.
    Dim StrTblExt As String       'Variable nom table externe.

    On Error GoTo Err

    'Nous contrôlons qu'un choix a bien été fait dans la ComboBox.
    If IsNull(Me.Cbo_SiteSaisie.Value) Then
        MsgBox " Vous devez sélectionner un secteur"
        Me.Cbo_SiteSaisie.SetFocus
        Exit Sub
    End If

    'Nous ressortons le chiffre du secteur choisi afin de l'ajouter au nom de la table interne.
    StrSecteur = Split((Me.Cbo_SiteSaisie.Column(1)), "_")
    StrTblExt = "Tbl_RelevesSite" & StrSecteur(UBound(StrSecteur))

    'Appelle la procédure de modification des liens avec le nom de la table externe comme argument.
    Call ModifyLink(StrTblExt)

    'Nous ouvrons le formulaire de saisie.
    DoCmd.OpenForm "Frm_Releves"
    'Nous attribuons le numéro du site au titre du formulaire.
    Form_Frm_Releves.Lbl_Titre.Caption = "Relevés secteur " & StrSecteur(UBound(StrSecteur))

    Exit Sub

Err:
    MsgBox "Erreur Ouverture formulaire saisie " & Err.Number & "  " & Err.Description, vbExclamation, "Problème sur ouverture formulaire"
    Resume Next

End Sub

IV-B-2. Ouverture de l'état par secteur

Nous ne développerons pas ce chapitre puisqu'il est globalement bâti sur le même principe que pour l'ouverture du formulaire.
Vous pourrez en voir le détail dans le fichier exemple joint.

IV-B-3. Ouverture de l'état global

Pour faire cet état, l'approche va être un peu différente.
En effet il va nous falloir cumuler les données de tous les sites.
Pour cela il nous faut alimenter une table temporaire 'Tbl_TmpReleves'.
Détaillons la démarche qui sera effectuée pour remplir cette table :

  • mettre à blanc la table en supprimant tous les enregistrements ;
  • créer une liaison sur la table extérieure 'Tbl_RelevesSite1' ;
  • insérer dans la table temporaire tous les enregistrements de cette table ;
  • supprimer la liaison de la table 'Tbl_RelevesSite1' et créer une liaison sur la table extérieure 'Tbl_RelevesSite2' ;
  • ajouter dans la table temporaire tous les enregistrements de cette table ;
  • supprimer la liaison de la table 'Tbl_RelevesSite2' et créer une liaison sur la table extérieure 'Tbl_RelevesSite3' ;
  • ajouter dans la table temporaire tous les enregistrements de cette table.

Voici donc la procédure correspondant à cette opération:

Code pour table temporaire 'Tbl_TmpReleves'
Sélectionnez
Private Sub SourceEtatGlobal()
'---------------------------------------------------------------------------------------
'Procédure de création de la source de l'état global
'---------------------------------------------------------------------------------------
    
    Dim StrSql As String
    Dim oDb As DAO.Database
    Dim oRst As DAO.Recordset

    On Error GoTo Fin
    Set oDb = CurrentDb

    'Supprime tous les enregistrements de la table temporaire 'Tbl_TmpReleves'.
    oDb.Execute "Delete * From Tbl_TmpReleves"
    'Détermine dans la table des liaisons les enregistrements dont la table interne a le nom 'Tbl_RelevesSite'.
    StrSql = "SELECT Tbl_Liens.Id_Lien, Tbl_Liens.TableInt, Tbl_Liens.Chemin, Tbl_Liens.TableExt " & _
             "FROM Tbl_Liens " & _
             "Where Tbl_Liens.TableInt  like 'Tbl_RelevesSite'; "
    Set oRst = oDb.OpenRecordset(StrSql, dbOpenSnapshot)

    If Not oRst.BOF Then
        oRst.MoveFirst   'Déplacement du pointeur sur le premier enregistrement.
    Else
        'S'il n'y a pas de liaison interne portant ce nom on quitte.
        MsgBox "Il n'y a pas de table correspondant à votre demande"
        Exit Sub
    End If

    'Sinon crée une boucle sur les enregistrements du Recordset.
    While Not oRst.EOF
        'Détruit la connexion.
        Call DeleteLink(oRst.Fields(1))
        'Recrée la connexion avec les arguments de l'enregistrement.
        Call CreateLink(oRst.Fields("TableInt"), oRst.Fields("Chemin"), oRst.Fields("TableExt"))

        'Insère dans la table les données corespondantes.
        oDb.Execute "INSERT INTO Tbl_TmpReleves " & _
                    "SELECT T1.Id_Salarie, T1.Date_Releve, T1.Heure_DebutAm, T1.Heure_FinAm, T1.Heure_DebutPm, T1.Heure_FinPm " & _
                    "FROM Tbl_RelevesSite As T1;"

        oRst.MoveNext
    Wend

    oDb.TableDefs.Refresh

    'Crée la requête source de l'état.
    Call Create_QryReport("Tbl_TmpReleves")

    'Ouvre l'état.
    DoCmd.OpenReport "Rpt_Releves", acViewPreview
    DoCmd.Maximize

Fin:

    If Err.Number <> 0 Then
        MsgBox "Le lien N° " & oRst.Fields("Id_Lien") & " n'est pas valide. Veuillez vérifier les paramètres.", vbInformation, "Lien invalide"
    End If

    oRst.Close
    oDb.Close
    Set oDb = Nothing
    Set oRst = Nothing

End Sub

IV-B-4. Maintenance

La première des maintenances consiste à pouvoir rapidement réparer les liens, en cas de déplacement ou de changement de nom des bases dorsales.
C'est le contrôle qui est fait au démarrage de l'application.
En cas de détection d'un problème. Un message vous indiquera qu'il y a une erreur:

Image non disponible

Une fois que vous aurez cliqué sur Oui, le formulaire de liaisons va s'ouvrir.
Lancez une validation, et il vous sera indiqué où est l'erreur.

Mais la maintenance, c'est également pouvoir adapter les programmes en fonction des besoins.
Imaginons qu'un site soit rajouté dans l'entreprise.
L'administrateur va donc rajouter dans la table 'Tbl_Sites' de la base 'TableSites.mdb' un nouvel enregistrement: 'Secteur_4'.
Il rajoutera également dans la base 'TablesHoraires.mdb' une table 'Tbl_RelevesSite4'.

Il nous suffira dans notre fichier frontal 'Releves.mdb' d'ouvrir le formulaire de liaisons et de rajouter une ligne:

Image non disponible

C'est tout.
La ComboBox de choix des sites aura le Secteur_4 ajouté, et les liens se feront également sur ce site.
Il n'y aura rien à changer pour les formulaires et états.

V. Conclusion

Nous arrivons au terme de cet article.

A l'issue de celui ci, vous devriez :
- mieux comprendre les mécanismes de création et suppression de liens ;
- pouvoir gérer vos liaisons avec des fichiers .mde ou .accde y compris avec le Runtime Access ;
- pouvoir modifier le formulaire de liaisons pour l'adapter à vos besoins.
   Vous pourrez ainsi supprimer :
      - la notion de lien permanents ;
      - la protection par mot de passe.
        Vous allégerez ainsi sensiblement le code.
    Mais vous pourrez également y ajouter :
      - une gestion de sécurité plus poussée ;
      - une notion de chemins relatifs ou non.
      ....

- Vous pourrez également mettre en place une gestion beaucoup plus automatisée, ne nécessitant pas la présence d'une table et formulaire consacrés.

V-A. Téléchargement

Une application 'démo' est disponible ici.
Décompressez l'ensemble du dossier directement sur C:\ et ouvrez le fichier: C:\TestLiaisons\Releves.mdb.
Après vous pourrez déplacer les fichiers ou renommer les tables, de façon à provoquer des erreurs et voir ainsi comment cela fonctionne.


V-B. Importation dans vos applications

Si vous voulez importer directement le formulaire, dans une de vos applications:
  - Ouvrez votre base.
  - Importez les objets suivants:
       - Tbl_Liens.
       - Frm_MotDePasse.
       - Frm_Liens.
       - Mdl_Liens.
       - Mdl_Utilitaires.
  - Pensez à lancer la fonction 'CheckLinks' au démarrage, soit par une macro 'autoexec', soit associée à un formulaire de démarrage.
  - Videz la table "Tbl_Liens".
  - Ouvrez le formulaire de gestion et saisissez vos données.

Si votre formulaire principal ne s'appelle pas 'Frm_Accueil', pensez à le renommer dans les fonctions 'CreatePermanentLinks' et 'CheckLinks'.

VI. Remerciements

Un grand merci à toute l'équipe de Dvp et plus particulièrement :

pour leur aide directe ou indirecte :
. Pierre Fauconnier
. Arkham46
. Argyronet
. Dolphy35
. LedZeppII
. Loufab


pour leurs corrections orthographiques et syntaxiques :
. Mahefasoa et ClaudeLELOUP

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants : Viadeo Twitter Facebook Share on Google+   

Copyright © 2011 Jean-Damien GAYOT. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.