Discussion :

[meud007]

Bonjour,

Je vous jure, j'ai méchament cherché la solution avant de poster ma question.

Rapidement:
J'ai un classeur "Gestion des pesées.xls" sur le réseau organisé comme une base de données.
A partir d'une autre application vba sous Excel, je souhaite récuperer certaines infos de cette base. Je me connecte donc à ce classeur via la méthode ADODB.

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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
Public Function TestCom(Table$, Nom$)
 
    Dim Source As ADODB.Connection
    Dim Requete As ADODB.Recordset
    Dim xSQL$, FiltreNom$, FiltreLot$, Filtre2$
    Dim dt As Date, j, m, a
    Dim Resultat(), l%, c%, c2%, f As ADODB.Field
 
 
    If Table = "Lots Reactifs" Then
        xSQL = "SELECT distinct Lot FROM [Lots Reactifs$] WHERE Nom_du_Réactif='" & Nom & _
                "' AND (Date_Elimination IS NULL Or Date_Elimination >= #" & Format(DateDuDosage, "yyyy/mm/dd") & "#)"
    ElseIf Table = "Solutions meres" Then
        xSQL = "SELECT Lot_Solution, préparateur FROM [Solutions meres$], [Produit$] WHERE [Produit$].Nom_Courant='" & Nom & _
                "' AND (Date_Elimination IS NULL Or Date_Elimination >= #" & Format(DateDuDosage, "yyyy/mm/dd") & "#)" & _
                " AND  [Produit$].Référence=[Solutions meres$].Référence_Produit"
    ElseIf Table = "Lots Produit" Then
        xSQL = "SELECT distinct Lot FROM [Lots Produit$], [Produit$] WHERE [Produit$].Nom_Courant='" & Nom & _
                "' AND  [Produit$].Référence=[Lots Produit$].Référence" & _
                " AND (Date_Elimination IS NULL Or Date_Elimination >= #" & Format(DateDuDosage, "yyyy/mm/dd") & "#);"
    End If
 
    Set Source = New ADODB.Connection
 
    With Source
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Persist Security Info = False" & ";" & _
            "Data Source=" & "R:\Gestion des pesées.xls" & ";" & _
            "Extended Properties=""Excel 8.0;" & _
            "HDR=" & "yes" & ";IMEX=1;"""
        .Open
        On Error GoTo fermeture
        Set Requete = New ADODB.Recordset
        Requete.CursorLocation = adUseServer
        Requete.Open xSQL, Source.ConnectionString, adOpenStatic, adLockUnspecified
 
        With Requete
            If Not .EOF Then
                ReDim Resultat(1 To .RecordCount, 1 To .Fields.Count)
                While Not .EOF
                    l = l + 1
                    c = 1
                    For Each f In .Fields
                        Resultat(l, c) = f.Value
                        c = c + 1
                    Next
                    .MoveNext
                Wend
            Else
                Resultat = Array()
            End If
            .Close
        End With
fermeture:
    On Error GoTo 0
    If Err.Number <> 0 Then MsgBox Err.Description: MsgBox xSQL
        .Close
    End With
 
    Set Requete = Nothing
    Set Source = Nothing
 
    Dim w As Workbook
    On Error Resume Next
        Set w = Nothing
        Set w = Workbooks("Gestion des pesées.xls")
    On Error GoTo 0
    If Not w Is Nothing Then w.Close savechanges:=False
    TestCom = Resultat
 
 
End Function

Tout marche très bien si le classeur "Gestion des pesées" est fermé ou si il est ouvert sur le poste qui lance la connection.
En revanche, si le classeur est ouvert sur un autre poste, Excel me signal que ce classeur est déjà ouvert et me propose soit une notification de fermeture, soit une ouverture en lecture seule.

Quelque soit la réponse, Excel ouvre une copie de ce classeur, visible à l'écran.

Après avoir récupéré mon info, je ferme la connection, mais si le fichier copié (image) est ouvert, je doir le fermer par le code.

Et malgré tout ça, j'ai toujours une trace de ce fichier dans l'éditeur de code VBA, c'est à dire si je me connecte 5 fois, je vais avoir 5 dossier VBPROJECT(""Gestion des pesées.xls") dans l'éditeur de code.

Je ne comprend pas comment régler ce probème.

Merci de votre aide

Dimitri

[Pierre Fauconnier]

Bonjour

Il y a plusieurs bugs liés au driver adodb d'Excel, et j'ai déjà eu pour ma part des problèmes similaires au tien. As-tu essayé de partager le classeur Excel source?

Ceci dit, Excel n'est pas un gestionnaire de données et encore moins un serveur de données => si tu veux l'utiliser comme tel, tu t'exposes à des problèmes.

[meud007]

Merci pour ta réponse et désolé si je tarde tant, mais pas de connection internet au boulot aujourd'hui.

Non, je n'ai pas essayer de mettre le classeur en partage. D'ailleurs, je ne vois pas comment faire.

Je suis un peu obligé de concerver Excel comme base de donnée car je veux que les utilisateurs puissent éventuellement corriger les enregistrements pendant que je développe mon code. C'est une activité secondaire au boulot. Il y a plein de bug à corriger et la structure de la base est en complète évolution. Au moins, les gens savent se servir d'Excel. Je veux également que cette base perdure si mon contrat n'est pas renouvelé. Sinon, tout se travaille pour rien. C'est pourquoi j'ai évité des bases genre SQL ou Access.

[meud007]

Finalement, j'ai trouvé une solution sur ce site, pas très propre mais qui résoud le problème.

L'idée est de copier le fichier base de donnée du lecteur réseau sur le disque local C, d'utiliser ADODB pour ce connecter au fichier sur le C puis de detruire le fichier du lecteur C

Comme la fonction FileCopy ne marche pas si le fichier est ouvert, j'ai trouvé ça dans les FAQ:

Code :

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

1
2
3
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" _
(ByVal lpExistingFileName As String, ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long

avant la connection:

Code :

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

CopyFile "r:\Gestion des pesées.xls", "c:\Gestion des pesées.xls", False

et à la fin

Code :

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

1
2
 
Kill "C:\Gestion des pesées.xls"