Discussion :

[jpharand]

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.

[FRED.G]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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 !

[FRED.G]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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.

[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é...

[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... ;-)

[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 ???

[jpharand]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[jpharand]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[jpharand]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[jpharand]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[jpharand]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[FRED.G]

peux-tu mettre une ligne de code exemple

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

Là je suis servi !

Bon je vais jeter un oeil à tout ça

Merci à toi

[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.

[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.

[=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 ?
_

[dacid]

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

En gros, voici ma macro:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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...

[=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.
_

[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 ?