Pourquoi cela fonctionnait samedi et plus maintenant ?

Le
Denys
Bonjour à tous,

J'essaie de copier de l'information depuis un classeur déjà ouvert.
Quelqu'un m'a proposé d'activer dans la bibliothèque de référence V=
BA,
le "Microsoft Activex Data Objects 2.8 Library" au lieu du 2.0 comme
dans le code qui suit:

Samedi, cela fonctionnait très bien et j'allais chercher de l'info sur
un fichier déjà ouvert. Aujourd'hui, rien à faire, Excel me répond =
que
le "Microsoft Jet database engine cannot open the file" parce que
fichier est déjà ouvert et que je n'y ai pas accès.
J'ai vérifié, la référence est toujours cochée.

Voici le code en question


'Must have the Microsoft Activex Data Objects 2.0 Library
'in the tools-referencein the VBA section (changé pour 2.8)
Sub GetExternalData(srcFile As String, _
srcSheet As String, _
srcRange As String, _
TTL As Boolean, _
outArr As Variant)
Dim myConn As ADODB.Connection, myCmd As ADODB.Command
Dim HDR As String, myRS As ADODB.Recordset, RS_n As Integer, RS_f As
Integer
Dim Arr

Set myConn = New ADODB.Connection
If TTL = True Then HDR = "Yes" Else HDR = "No"
myConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & srcFile & ";" & _
"Extended Properties=""Excel 8.0;" & _
"HDR=" & HDR & ";IMEX=1;"""
Set myCmd = New ADODB.Command
myCmd.ActiveConnection = myConn
If srcSheet = "" _
Then myCmd.CommandText = "SELECT * from `" & srcRange & "`" _
Else myCmd.CommandText = "SELECT * from `" & srcSheet & "$" &
srcRange & "`"
Set myRS = New ADODB.Recordset
myRS.Open myCmd, , adOpenKeyset, adLockOptimistic
ReDim Arr(1 To myRS.RecordCount, 1 To myRS.Fields.Count)
myRS.MoveFirst
Do While Not myRS.EOF
For RS_n = 1 To myRS.RecordCount 'lignes
For RS_f = 0 To myRS.Fields.Count - 1 'colonnes
Arr(RS_n, RS_f + 1) = myRS.Fields(RS_f).Value
Next
myRS.MoveNext
Next
Loop
myConn.Close
Set myRS = Nothing
Set myCmd = Nothing
Set myConn = Nothing

outArr = Arr

End Sub

Si quequ'un y comprend quelque chose, cela m'aiderait beaucoup.

Merci

Denys
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichDenis
Le #5012801
J'ai testé cette procédure à nouveau....
je éprouve aucun problème à extraire les données
d'un fichier même si ce dernier est ouvert... j'ai même
testé en ouvrant le même fichier dans 2 instances
différentes de l'application Excel.

Essaie à nouveau cette procédure dans un nouveau classeur
as-tu toujours des difficultés ?


"Denys"
Bonjour à tous,

J'essaie de copier de l'information depuis un classeur déjà ouvert.
Quelqu'un m'a proposé d'activer dans la bibliothèque de référence VBA,
le "Microsoft Activex Data Objects 2.8 Library" au lieu du 2.0 comme
dans le code qui suit:

Samedi, cela fonctionnait très bien et j'allais chercher de l'info sur
un fichier déjà ouvert. Aujourd'hui, rien à faire, Excel me répond que
le "Microsoft Jet database engine cannot open the file" parce que
fichier est déjà ouvert et que je n'y ai pas accès.
J'ai vérifié, la référence est toujours cochée....

Voici le code en question...


'Must have the Microsoft Activex Data Objects 2.0 Library
'in the tools----reference---in the VBA section (changé pour 2.8)
Sub GetExternalData(srcFile As String, _
srcSheet As String, _
srcRange As String, _
TTL As Boolean, _
outArr As Variant)
Dim myConn As ADODB.Connection, myCmd As ADODB.Command
Dim HDR As String, myRS As ADODB.Recordset, RS_n As Integer, RS_f As
Integer
Dim Arr

Set myConn = New ADODB.Connection
If TTL = True Then HDR = "Yes" Else HDR = "No"
myConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & srcFile & ";" & _
"Extended Properties=""Excel 8.0;" & _
"HDR=" & HDR & ";IMEX=1;"""
Set myCmd = New ADODB.Command
myCmd.ActiveConnection = myConn
If srcSheet = "" _
Then myCmd.CommandText = "SELECT * from `" & srcRange & "`" _
Else myCmd.CommandText = "SELECT * from `" & srcSheet & "$" &
srcRange & "`"
Set myRS = New ADODB.Recordset
myRS.Open myCmd, , adOpenKeyset, adLockOptimistic
ReDim Arr(1 To myRS.RecordCount, 1 To myRS.Fields.Count)
myRS.MoveFirst
Do While Not myRS.EOF
For RS_n = 1 To myRS.RecordCount 'lignes
For RS_f = 0 To myRS.Fields.Count - 1 'colonnes
Arr(RS_n, RS_f + 1) = myRS.Fields(RS_f).Value
Next
myRS.MoveNext
Next
Loop
myConn.Close
Set myRS = Nothing
Set myCmd = Nothing
Set myConn = Nothing

outArr = Arr

End Sub

Si quequ'un y comprend quelque chose, cela m'aiderait beaucoup....

Merci

Denys
Denys
Le #5012791
Bonsoir Denis,

Ce que tu me dis me rassure un peu.... je ne suis quand même pas
fou... ça fonctionnait parfaitement bien samedi dernier.... je vais
réessayer demain matin....

Merci

Denys

On 30 oct, 21:49, "MichDenis"
J'ai testé cette procédure à nouveau....
je éprouve aucun problème à extraire les données
d'un fichier même si ce dernier est ouvert... j'ai même
testé en ouvrant le même fichier dans 2 instances
différentes de l'application Excel.

Essaie à nouveau cette procédure dans un nouveau classeur
as-tu toujours des difficultés ?



Denys
Le #5012781
Finalement, curiosité aidant, j'ai essayé sur un autre classeur avec
le même résultat....

Run time error -2147462759(80004005) Microsoft Jet database engine
cannot open the file.....

Tout ça n'est pas logique...Je réessaye demain Y a sûrement quelque
chose que je fais de pas correct....

Merci

Denys
MichDenis
Le #5012771
J'ai aussi testé cette procédure... plus simple et possiblement
plus rapide sans problème même si le fichier source est ouvert :

'----------------------------------
Sub Test()

'appel d'une procédure à 4 paramètres
'A ) Chemin & nom du fichier : "c:AAAclasseur1.xls"
'B ) Nom de la feuille : "toto"
'C ) Plage de cellule à extraire : Range("A12:B25")
'D ) Où copier le résultat : _
' ThisWorkbook.Worksheets(1).Range("A1")

Extraire_Data_Classeur_Fermer "c:AAAclasseur1.xls", _
"toto", Range("A12:B25"), ThisWorkbook.Worksheets(1).Range("A1")

End Sub
'----------------------------------
Sub Extraire_Data_Classeur_Fermer(fichier As String, _
NomFeuille As String, Rg As Range, Destination As Range)

Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String
Dim file As String, C As Integer, Ok As Integer
Dim ModeCalcul As String

ModeCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & fichier & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'Détermine la requête à être exécuté
Requete = "SELECT * FROM [" & NomFeuille & "$" & Rg.Address(0, 0) & "]"

'Exécution de la requête
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic

'Copie le nom des champs du recordset vers Excel
Do
Destination.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
'Copie le recordset vers Excel
Destination.Offset(1).CopyFromRecordset Rst
'Ferme le recordset et la connection
Rst.Close: Conn.Close
Application.Calculation = ModeCalcul
Application.EnableEvents = True
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing: Set Destination = Nothing
End Sub
'----------------------------------





"Denys"
Finalement, curiosité aidant, j'ai essayé sur un autre classeur avec
le même résultat....

Run time error -2147462759(80004005) Microsoft Jet database engine
cannot open the file.....

Tout ça n'est pas logique...Je réessaye demain Y a sûrement quelque
chose que je fais de pas correct....

Merci

Denys
MichDenis
Le #5012761
Dans la procédure, il y a des déclarations de variables
que j'ai omise d'enlever - fait rapidement à partir d'un
autre bout de code....

Si ça ne fonctionne pas, essaie en ajoutant cette ligne
de code : Conn.Mode = adModeRead
juste après celle-ci :
Set Conn = New ADODB.Connection
Conn.Mode = adModeRead
' le reste de la procédure !



"MichDenis" uT6$
J'ai aussi testé cette procédure... plus simple et possiblement
plus rapide sans problème même si le fichier source est ouvert :

'----------------------------------
Sub Test()

'appel d'une procédure à 4 paramètres
'A ) Chemin & nom du fichier : "c:AAAclasseur1.xls"
'B ) Nom de la feuille : "toto"
'C ) Plage de cellule à extraire : Range("A12:B25")
'D ) Où copier le résultat : _
' ThisWorkbook.Worksheets(1).Range("A1")

Extraire_Data_Classeur_Fermer "c:AAAclasseur1.xls", _
"toto", Range("A12:B25"), ThisWorkbook.Worksheets(1).Range("A1")

End Sub
'----------------------------------
Sub Extraire_Data_Classeur_Fermer(fichier As String, _
NomFeuille As String, Rg As Range, Destination As Range)

Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String
Dim file As String, C As Integer, Ok As Integer
Dim ModeCalcul As String

ModeCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & fichier & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'Détermine la requête à être exécuté
Requete = "SELECT * FROM [" & NomFeuille & "$" & Rg.Address(0, 0) & "]"

'Exécution de la requête
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic

'Copie le nom des champs du recordset vers Excel
Do
Destination.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
'Copie le recordset vers Excel
Destination.Offset(1).CopyFromRecordset Rst
'Ferme le recordset et la connection
Rst.Close: Conn.Close
Application.Calculation = ModeCalcul
Application.EnableEvents = True
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing: Set Destination = Nothing
End Sub
'----------------------------------





"Denys"
Finalement, curiosité aidant, j'ai essayé sur un autre classeur avec
le même résultat....

Run time error -2147462759(80004005) Microsoft Jet database engine
cannot open the file.....

Tout ça n'est pas logique...Je réessaye demain Y a sûrement quelque
chose que je fais de pas correct....

Merci

Denys
Denys
Le #5012391
Bonjour Denis,

Merci beaucoup, je m'y mets dès ce matin et je te reviens...

Bonne journée

Denys
Denys
Le #5012021
Bonjour Denis,

Cette fois-ci, c'est parfait...

Merci infiniment

Denys
MichDenis
Le #5011971
Qu'as-tu utiliser comme procédure ?


"Denys"
Bonjour Denis,

Cette fois-ci, c'est parfait...

Merci infiniment

Denys
Denys
Le #5011251
Bonjour Denis,

Je suis damné.... tu ne me coiras pas, mais ce matin, cela ne marche
plus.... j'ai encore comme réponse que le Microsoft Data Jet engine ne
peut accéder à l'information. Le fait qu'à l'ouverture du fichier un
userform apparaisse et demande à l'usager de mettre un mot de passe ne
devrait rien changer puisque cela fonctionne avec un fichier
fermé.....

J'ai essayé ta première recommandation. Je vais essayer la seconde ce
matin...

Je reviens

Denys

On 31 oct, 13:29, "MichDenis"
Qu'as-tu utiliser comme procédure ?

"Denys"
Bonjour Denis,

Cette fois-ci, c'est parfait...

Merci infiniment

Denys


Denys
Le #5011221
Vois-tu,

Le débuggeur d'Excel met ce qui suit en jaune:

Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & fichier & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

disant que le fichier est déjà ouvert et que je n'y ai pas accès


Denys




On 31 oct, 13:29, "MichDenis"
Qu'as-tu utiliser comme procédure ?

"Denys"
Bonjour Denis,

Cette fois-ci, c'est parfait...

Merci infiniment

Denys


Publicité
Poster une réponse
Anonyme