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