[VBA] Ajouter dynamiquement une référence

Version imprimable

20/09/2004, 09h51
jpharand

[VBA] Ajouter dynamiquement une référence

Bonjour à tous.

Voilà ce que je cherche à faire, et en rouge, ce que je n'arrive pas à faire.
Lors du lancement de mon application VBA, un module (de mon fichier interface.mdb, qui me sert d'interface) vérifie la présence de :
- la base de données ("données.mdb"),
- un module additionnel ("ChLettres.mde"),
- et une dll permettant de désactiver la souris sous Access2000 ("MouseWheel.dll").
Ensuite, si leur présence est confirmée, je dois référencer "ChLettres.mde" ainsi que "MouseWheel.dll". Mais je veux faire cela par le code, à chaque démarrage de l'application, et non pas par "Outils, Référence, Ajouter...".

L'application peut ensuite, vraiment, démarrer tranquillement puisque 'on a vérifié la présence des données et que l'on a correctement inscrit les références présentes.

Quelqu'un peut-il m'aider à résoudre mon problème, en rouge ci-dessus ?
D'avance, je vous en remercie.
20/09/2004, 10h37
FRED.G

Pour ajouter une référence, utiliser la méthode AddFromFile de l'objet References.

Code:

References.AddFromFile("C:\Program Files\Common Files\System\ado\msado21.tlb ")

:D
20/09/2004, 10h40
jpharand

Oh, merci beaucoup !!!
Je sens que ça va marcher !!!
J'essaye et je vous tiens au courant... mais je sens que c'est bon !

Et pour vérifier les références exitantes :

Code:

1
2
3
4
5
6
Function GetReferences() 
Dim Ref As Reference 
For Each Ref In Application.References 
    Debug.Print "Référence : " & Ref.name & " - Version : " & Ref.Major & " - FullPath : " & Ref.FullPath 
Next Ref 
End Function

:wink:

20/09/2004, 11h17
jpharand

Merci FRED.
L'ajout marche terriblement bien !
Je vais donc utiliser également la fonction ci-dessus pour tester les références déjà existantes, pour les supprimer lorsque l'on quitte l'application... (puisque l'on obtient un message d'erreur si l'on essaye de les ajouter deux fois...)
J'ai trouvé la méthode "Remove" qui permet de supprimer une référence.
Merci encore.
20/09/2004, 11h32
FRED.G

Si ton pb est résolu merci de mettre le tag :)

Et au passage, peux-tu mettre une ligne de code exemple avec la méthode remove comme ça je l'intégrerai à la FAQ avec les 2 autres codes que je t'ai donné...
20/09/2004, 11h34
jpharand

OK FRED, je remets tout ça en ordre proprement, je vérifie que tout fonctionne et je vous poste tout ça, puis je mettrai le tag [resolu].
A tout à l'heure... ;-)
20/09/2004, 16h58
jpharand

Me revoilà.
Voici mon code final...

Je vais vous expliquer.

Tout d'abord, sachez que mon applic se décompose en 4 fichiers :
- L'interface au format mdb,
- les données, au format mdb,
- une dll, au format... dll,
- et une autre sorte de dll, au format... mde.

L'appli se lance en exécutant l'interface.

L'interface possède une macro AUTOEXEC, qui lance la procédure "Démarrage()".
Cette procédure fait des tests pour vérifier si l'application est susceptible de marcher ; si ce n'est pas le cas, un message d'erreur donne la liste des fichiers manquants et referme l'application ; alors que si c'est le cas, on enregistre les deux références nécessaires, et on contrôle que la liaison avec les données est à jour, sinon on effectue une mise à jour de cette liaison.

Prêts à voir le code ???

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Public Function Demarrage()
     Call SupprimerReferences
     If VerifierPresenceFichiersNecessaires() Then
          Call VerifierLien
          Call AjouterReferences
          Exit Function
     Else
          GoTo Demarrage_Annulé ' on annule l'ouverture de l'appli.
     End If
Demarrage_Annulé:
     Application.Quit (acQuitSaveNone)
End Function

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Public Sub SupprimerReferences()
     Dim Ref As Reference
     If ExisteReference("modchLettres") Then
          Set Ref = References("modchLettres")
          References.Remove Ref
     End If
     If ExisteReference("MouseWheel") Then
          Set Ref = References("MouseWheel")
          References.Remove Ref
     End If
 
    For Each Ref In References
        If Ref.IsBroken Then
            Debug.Print "GUID des références rompues:"
            Debug.Print Ref.Guid
        End If
    Next Ref
End Sub

Code:

1
2
3
4
5
6
7
8
9
Private Function ExisteReference(NomRef As String) As Boolean
     Dim Ref As Reference
     ExisteReference = False
     For Each Ref In Application.References
          If Ref.Name = NomRef Then
               ExisteReference = True
          End If
     Next Ref
End Function

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Function VerifierPresenceFichiersNecessaires() As Boolean
     VerifierPresenceFichiersNecessaires = True
 
     Dim CheminCourant As String
     CheminCourant = CurrentProject.Path
 
     'Tester pour ChLettres.mde ; GRC Transversalis (données).mdb ; MouseWheel.dll
     Dim NbErreursFichier As Integer
     NbErreursFichier = 0
     Dim MessageDErreur As String
     MessageDErreur = "ERREUR : Voici la liste des fichiers manquants :"
     If Dir(CheminCourant & "\ChLettres.mde", vbHidden) <> "" Then
     Else
          NbErreursFichier = NbErreursFichier + 1
          MessageDErreur = MessageDErreur & Chr$(13) & Chr$(10) & "- 'ChLettres.mde'"
     End If
     If Dir(CheminCourant & "\GRC Transversalis (données).mdb", vbHidden) <> "" Then
          'MsgBox "'GRC Transversalis (données).mdb' existe"
     Else
          NbErreursFichier = NbErreursFichier + 1
          MessageDErreur = MessageDErreur & Chr$(13) & Chr$(10) & "- 'GRC Transversalis (données).mdb'"
     End If
     If Dir(CheminCourant & "\MouseWheel.dll", vbHidden) <> "" Then
     Else
          NbErreursFichier = NbErreursFichier + 1
          MessageDErreur = MessageDErreur & Chr$(13) & Chr$(10) & "- 'MouseWheel.dll'"
     End If
 
     If (NbErreursFichier > 0) Then
          VerifierPresenceFichiersNecessaires = False
          If NbErreursFichier = 1 Then
               MessageDErreur = MessageDErreur & Chr$(13) & Chr$(10) & _
                    "Ce fichier est nécessaire au bon fonctionnement de GRC Transversalis." & Chr$(13) & Chr$(10) & _
                    "Placez le fichier manquant dans le même répertoire que le fichier 'GRC Transversalis.mdb' et relancez l'application."
          Else
               MessageDErreur = MessageDErreur & Chr$(13) & Chr$(10) & _
                    "Ces fichiers sont nécessaires au bon fonctionnement de GRC Transversalis." & Chr$(13) & Chr$(10) & _
                    "Placez les fichiers manquants dans le même répertoire que le fichier 'GRC Transversalis.mdb' et relancez l'application."
          End If
          MsgBox (MessageDErreur)
     End If
End Function

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Private Sub VerifierLien()
     Dim bd As Database
     Dim q As QueryDef
     Dim r As Recordset
     Dim Requete As String
     Dim DernierLien As String
     Set bd = CurrentDb()
     Requete = "Select Valeur FROM [Paramétrage] WHERE Intitulé = 'AdresseDonnées'"
     Set q = bd.CreateQueryDef("", Requete)
     Set r = q.OpenRecordset()
     If r.RecordCount > 0 Then
          r.MoveFirst
          DernierLien = r.Fields(0)
     Else
          DernierLien = ""
     End If
     r.Close
     bd.Close
 
     Dim CheminCourant As String
     CheminCourant = CurrentProject.Path
 
     If ((DernierLien = "") Or (DernierLien = " ") Or (DernierLien <> CheminCourant)) Then
          'MsgBox ("DernierLien : " & DernierLien)
          'MsgBox ("CheminCourant : " & CheminCourant)
          MsgBox ("La base de données a probablement été déplacée." & Chr$(13) & Chr$(10) & _
               "Son chemin à sa dernière ouverture était :" & Chr$(13) & Chr$(10) & _
               DernierLien & Chr$(13) & Chr$(10) & _
               Chr$(13) & Chr$(10) & _
               "La mise à jour du lien va débuter. Cliquez sur 'OK'.")
          Call mettreAJourLien(DernierLien, CheminCourant)
     End If
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Public Sub mettreAJourLien(DernierLien, CheminCourant)
     Call supprimerAncienLien
 
     MsgBox "1/3 : Suppression de l'ancien lien : OK." & Chr$(13) & Chr$(10) & _
            "2/3 : Mise à jour de la table Paramétrage..."
     DoCmd.SetWarnings False
     DoCmd.RunSQL "Update [Paramétrage] SET Valeur='" & CheminCourant & "' WHERE Intitulé = 'AdresseDonnées'"
     DoCmd.SetWarnings True
 
     MsgBox "1/3 : Suppression de l'ancien lien : OK." & Chr$(13) & Chr$(10) & _
            "2/3 : Mise à jour de la table Paramétrage : OK." & Chr$(13) & Chr$(10) & _
            "3/3 : Mise à jour du lien avec les données..."
     CheminCourant = CheminCourant & "\GRC Transversalis (données).mdb"
     DoCmd.TransferDatabase acLink, "Microsoft Access", CheminCourant, acTable, "ApporteurAffaire", "ApporteurAffaire"
     DoCmd.TransferDatabase acLink, "Microsoft Access", CheminCourant, acTable, "Catégorie", "Catégorie"
     DoCmd.TransferDatabase acLink, "Microsoft Access", CheminCourant, acTable, "Civilité", "Civilité"
     DoCmd.TransferDatabase acLink, "Microsoft Access", CheminCourant, acTable, "Client-Contact", "Client-Contact"
     DoCmd.TransferDatabase acLink, "Microsoft Access", CheminCourant, acTable, "Commande", "Commande"
     DoCmd.TransferDatabase acLink, "Microsoft Access", CheminCourant, acTable, "CommandeDossier", "CommandeDossier"
     DoCmd.TransferDatabase acLink, "Microsoft Access", CheminCourant, acTable, "Contact", "Contact"
     DoCmd.TransferDatabase acLink, "Microsoft Access", CheminCourant, acTable, "Devis", "Devis"
     DoCmd.TransferDatabase acLink, "Microsoft Access", CheminCourant, acTable, "Entité", "Entité"
     DoCmd.TransferDatabase acLink, "Microsoft Access", CheminCourant, acTable, "Facture", "Facture"
     DoCmd.TransferDatabase acLink, "Microsoft Access", CheminCourant, acTable, "Intervenant", "Intervenant"
     DoCmd.TransferDatabase acLink, "Microsoft Access", CheminCourant, acTable, "Livraison", "Livraison"
     DoCmd.TransferDatabase acLink, "Microsoft Access", CheminCourant, acTable, "Montant", "Montant"
     ' Ne pas importer la table [Paramétrage] car on garde cette table !
     DoCmd.TransferDatabase acLink, "Microsoft Access", CheminCourant, acTable, "Pays", "Pays"
    'etc. Je vous fais grâce de la liste complète de mes tables...
 
     MsgBox "1/3 : Suppression de l'ancien lien : OK." & Chr$(13) & Chr$(10) & _
            "2/3 : Mise à jour de la table Paramétrage : OK." & Chr$(13) & Chr$(10) & _
            "3/3 : Mise à jour du lien avec les données : OK." & Chr$(13) & Chr$(10) & _
            Chr$(13) & Chr$(10) & _
            "La mise à jour est terminée."
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Public Sub supprimerAncienLien()
     MsgBox "1/3 : Suppression de l'ancien lien..."
          DoCmd.RunSQL ("DROP TABLE [ApporteurAffaire]")
          DoCmd.RunSQL ("DROP TABLE [Catégorie]")
          DoCmd.RunSQL ("DROP TABLE [Civilité]")
          DoCmd.RunSQL ("DROP TABLE [Client-Contact]")
          DoCmd.RunSQL ("DROP TABLE [Commande]")
          DoCmd.RunSQL ("DROP TABLE [CommandeDossier]")
          DoCmd.RunSQL ("DROP TABLE [Contact]")
          DoCmd.RunSQL ("DROP TABLE [Devis]")
          DoCmd.RunSQL ("DROP TABLE [Entité]")
          DoCmd.RunSQL ("DROP TABLE [Facture]")
          DoCmd.RunSQL ("DROP TABLE [Intervenant]")
          DoCmd.RunSQL ("DROP TABLE [Livraison]")
          DoCmd.RunSQL ("DROP TABLE [Montant]")
          ' Ne pas effacer la table [Paramétrage] car on y enregistre le dernier chemin valide !
          DoCmd.RunSQL ("DROP TABLE [Pays]")
          'etc. Je vous fais grâce de la liste complète de toutes mes tables...
End Sub

Et enfin, ce qui était l'objet de ma question...
Code:

1 2 3 Private Sub AjouterReference(CheminRef As String) References.AddFromFile (CheminRef) End Sub
Code:

1 2 3 4 5 6 7 Private Sub AjouterReferences() Dim CheminCourant As String CheminCourant = CurrentProject.Path AjouterReference (CheminCourant & "\ChLettres.mde") AjouterReference (CheminCourant & "\MouseWheel.dll") 'pour bloquer la moulinette dans les formulaires, mais ATTENTION : ne sert que sous Office 2000 End Sub
Dernière précision, lorsque l'on quitte l'appli, je supprime les références que j'ai moi-même ajouté, afin de pouvoir les rajouter la fois d'après !

Un grand merci à FRED.

20/09/2004, 17h31
FRED.G

Citation:

Envoyé par FRED.G

peux-tu mettre une ligne de code exemple

:mouarf1:

Moi qui avait simplement demandé 1 ligne de code... :lol:

Là je suis servi ! :wink:

Bon je vais jeter un oeil à tout ça :D

Merci à toi :)
21/09/2004, 12h13
jpharand

J'avoue que mon code est un peu impressionnant et peu en rebuter plus d'un !
D'autant que j'avous ne pas commenter énormément !

Bon, enfin, j'essaie toujours d'utiliser des noms de fonction qui "parlent", quitte à ce que ces noms soient très très longs...

Si ce code peut servir, ou si vous trouvez une amélioration, ou si vous avez des questions, n'hésitez pas.
25/02/2008, 09h46
dacid

Le problème, c'est que pour que VBA connaisse l'objet "Reference", il faut lui ajouter la référence "Microsoft Visual basic for application extensibility ..."
Et en plus, ca ne lui fait pas connaitre l'objet Application.References.. Il ne la connait pas non plus par défaut.
Il se tire un peu une balle dans le pied.

Voici mon cas de figure:
J'ai un fichier bas qui comporte des accès aux données.
J'attache dynamiquement (depuis delphi) ce module au modèle Word, seulement, la référence ADO n'est pas présente par défaut, il plante donc sur la déclaration de DAO.Database.

Pouvez vous m'aider ?

Merci d'avance.
25/02/2008, 13h33
=JBO=

Bonjour,

Pourrais-tu préciser ?

Avec Delphi tu utilises l'Automation pour piloter une application Word ou une application Access ?

Quelle est ta version d'Access ?
_

Je pilote du Word 2003 qui va chercher ses données dans Access 2003.

En gros, voici ma macro:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Dim mydb As DAO.Database Dim myRS As DAO.Recordset Set mydb = DAO.OpenDatabase(chemBase) mySQL = "SELECT * FROM TblStyles WHERE Id=" & myId Set myRS = mydb.OpenRecordset(mySQL) myRS.MoveFirst While Not myRS.EOF Coloriage_Style myRS("NomStyle"), Couleur, myRS("FondouPolice") myRS.MoveNext Wend myRS.Close Set myRS = Nothing
Et ca plante dès la première déclaration car lorsque j'attache dynamiquement le fichier Bas, il perd la référence à ADO.

Or pour pouvoir ajouter une réference dynamiquement, il faut ajouter une référence... :roll:

25/02/2008, 14h16
=JBO=

Désolé, je serai disponible plus tard pour t'aider.

En attendant...
Je pense qu'il existe plusieurs solutions comme, par exemple l'utilisation d'une liaison tardive (une sorte de référence tardive).
De plus, j'ai l'impression qu'il y a un souci dans ton code... car je ne vois pas comment tu récupères l'objet DAO.Database.

A plus tard.
_
25/02/2008, 14h19
dacid

Tu me laisses perplexe...

J'utilise DAO.Database depuis quelques temps déjà, et il n'y a rien à récupérer... Il suffit d'ajouter la référence DAO et l'utiliser comme décrit, nan ?
8O
25/02/2008, 18h16
=JBO=

Citation:

Envoyé par dacid

Tu me laisses perplexe...

J'utilise DAO.Database depuis quelques temps déjà, et il n'y a rien à récupérer... Il suffit d'ajouter la référence DAO et l'utiliser comme décrit, nan ?

Oui, mais seulement à condition que la bibliothèque DAO soit référencée. :aie:

Ou bien alors, dans Access seulement, tu utilises la propriété CurrentDB, voire DBEngine.
_

Citation:

Envoyé par dacid

Je pilote du Word 2003 qui va chercher ses données dans Access 2003.

Citation:

Envoyé par dacid

Le problème, c'est que pour que VBA connaisse l'objet "Reference", il faut lui ajouter la référence "Microsoft Visual basic for application extensibility ..."
Et en plus, ca ne lui fait pas connaitre l'objet Application.References.. Il ne la connait pas non plus par défaut.
Il se tire un peu une balle dans le pied.

Apparemment tu fais une confusion entre Access et Excel (ici c'est le forum Access ;)).

La propriété Application.References concerne seulement Access et non pas Excel. Donc tu ne peux pas utiliser cette propriété dans Excel.

Citation:

Envoyé par dacid

Voici mon cas de figure:
J'ai un fichier bas qui comporte des accès aux données.
J'attache dynamiquement (depuis delphi) ce module au modèle Word, seulement, la référence ADO n'est pas présente par défaut, il plante donc sur la déclaration de DAO.Database.

Je suis curieux (et intéressé) de voir comment tu t'y prends pour << attacher dynamiquement (depuis delphi) ce module au modèle Word >>.
Peux-tu nous montrer un exemple de code (même du Pascal :)) ?

Dans tes messages, tantôt tu parles de DAO.Database (donc la bibliothèque DAO), tantôt tu parles de la référence ADO (donc la bibliothèque ADODB) ???
Mais dans le code que tu donnes, les types d'objets sont préfixés par DAO... donc c'est la bibliothèque DAO que tu veux référencer... OK ?!

Il est possible de travailler avec la bibliothèque DAO sans l'avoir référencée au préalable: c'est ce qu'on appelle une liaison tardive.
La technique de la liaison tardive a déjà été évoquée sur le forum Access, notamment pour piloter une application Excel par l'Automation.

Le principe de la liaison tardive est de ne pas typer les objets et de faire appel à la commande CreateObject ou de récupérer une référence sur un objet (par exemple Application.VBE).

Je vais te donner un exemple en adaptant ton code pour une liaison tardive à la bibliothèque DAO 3.6.

Remarque:
Pour ouvrir un objet Database, il faut d'abord un objet DBEngine.
Dans le cas d'une liaison tardive il faut créer cet objet DBEngine.
En revanche, si la bibliothèque est référencée, l'objet DBEngine est automatiquement créé.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Dim myEngine as Object Dim mydb As Object Dim myRS As Object Set myEngine = CreateObject("DAO.DBEngine.36") Set mydb = myEngine.OpenDatabase(chemBase) mySQL = "SELECT * FROM TblStyles WHERE Id=" & myId Set myRS = mydb.OpenRecordset(mySQL) myRS.MoveFirst While Not myRS.EOF Coloriage_Style myRS("NomStyle"), Couleur, myRS("FondouPolice") myRS.MoveNext Wend myRS.Close Set myRS = Nothing mydb.Close Set mydb = Nothing Set myEngine = Nothing
Dernière remarque:
Si tu veux ajouter une référence à ton application Excel, tu peux envisager d'utiliser la bibliotèque "Microsoft Visual Basic for Application Extensibility..." au moyen d'une liaison tardive...
ce qui devrait extirper la balle précédemment tirée dans le pied ! :mouarf: :mouarf: :mouarf:
_

Bonjour à tous,
Je me glisse dans la fin de cette discussion, pour savoir en quelle(s) version(s) fonctionne le code proposé (97,2000,2002,2007 ?)
Si c'est du 97, et que le but de la fonction

Code:

Public Sub mettreAJourLien(DernierLien, CheminCourant)

est de recréer tous les liens existants pour l'ensemble des tables attachés, j'ai eventuellement un code plus simple, avec boucle, ce qui évite de citer toutes les tables
(je n'ai fait qu'adapter un code trouvé sur le net, mais c'est celui que j'utilise)

(mais peut être que ta méthode est plus rapide que la mienne ?)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 Function ModifAttache(strDBPath) ' Modification simple des attaches ' sur le modèle de fGetLinkPath de Dev Ashish ' 21/07/2005 Dim vieuxnom As String, stPath As String Dim loTd As TableDef Dim dbs As Database Dim I, nb As Integer I = 0 CurrentDb.TableDefs.Refresh ' nb de table nb = CurrentDb.TableDefs.Count For Each loTd In CurrentDb.TableDefs On Error Resume Next stPath = dbs.TableDefs(loTd.Name).Connect If stPath = Null Then Else I = I + 1 vieuxnom = fGetLinkPath(loTd.Name) loTd.Connect = ";Database=" & strDBPath loTd.RefreshLink Debug.Print loTd.Name; " "; fGetLinkPath(loTd.Name); " à la place de : "; vieuxnom End If Next loTd Set loTd = Nothing CurrentDb.TableDefs.Refresh MsgBox "Terminé." & vbCrLf & I & " tables attachées pointent désormais vers la base de données " & strDBPath, vbOKOnly, "Procédure terminée avec succés" End Function
voila ma modeste contribution.

fevec

16/04/2010, 23h28
jmde

Bonsoir,

Je voudrais utiliser le code de jpharand (Ajouter dynamiquement une référence), et pour bien le comprendre j'ai besoin de quelques explications.

Citation:

Tout d'abord, sachez que mon applic se décompose en 4 fichiers :
- L'interface au format mdb,
- les données, au format mdb,
- une dll, au format... dll,
- et une autre sorte de dll, au format... mde.

Par interface au format mdb, et les données, au format mdb
Est-ce qu’il s’agit des bases dorsale et Frontale ?

Par contre une dll, au format... dll, et une autre sorte de dll, au format... mde. là je ne comprends pas et je ne sais pas comment faire.

Pouvez-vous me donner un exemple ?

Merci pour votre aide.

Salutations.