Bug Connection classeur xls via adodb
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:
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