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.
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:
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:
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.
Nous cliquons sur le bouton de recherche de fichiers.
Nous choisissons un fichier dans la fenêtre de recherche.
Nous pouvons maintenant choisir dans le fichier sélectionné une table externe à l'aide de la liste déroulante.
Nous continuons à saisir nos liaisons et nous validons.
Nous pouvons voir que toutes nos tables apparaissent bien dans la liste correspondante.
Nous pouvons également constater la correspondance avec le gestionnaire d'attaches intégré d'Access.
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.
En positionnant la souris sur la table correspondante, nous pouvons voir que le lien est bon.
Maintenant modifions le chemin de la ligne1 (pour en faire un chemin erroné).
Mettons '\fichiers2\' au lieu de '\fichiers\'.
Validons. Nous aurons un message d'erreur.
Modifions de nouveau le chemin de la ligne1 (pour se mettre sur un fichier sécurisé).
Validons. Nous aurons un autre message d'erreur.
Qui nous ouvrira le formulaire de saisie de mot de passe.
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
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.
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.
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.
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.
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 SubII-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.
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.
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 SubII-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.
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 SubII-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.
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 FunctionII-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.
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 SubII-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.
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 SubII-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.
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 FunctionII-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.
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 FunctionII-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.
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 SubII-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".
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.
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.
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 SubII-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'.
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 SubII-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:
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' :
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'.
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 SubII-D-4. Bouton 'Cmd_Valid'▲
Ce bouton va nous permettre de faire l'opération de mise à jour.
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 SubII-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.
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 SubII-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.
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 SubIII. 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é.
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.
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.
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:
Au démarrage de l'application, nous n'aurons besoin de nous connecter que sur le fichier 'Paramètres', avec deux liaisons permanentes
Si nous voulons travailler sur la table 'RelevesSite2', nous ajouterons la connexion et la liaison correspondante.
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.
1) Nous choisissons un site dans la liste déroulante correspondante.
Cette liste aura comme source notre table 'Tbl_Sites'
Nous validons et nous arrivons sur le formulaire de saisie du site_2.
Si nous choisissons Secteur_1 dans la liste des états et si nous validons nous aurons ceci.
Si nous cliquons sur le bouton 'Etat global' nous aurons un état correspondant aux trois secteurs.
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.
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 SubIV-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:
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 SubIV-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:
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:
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