Pourquoi cela fonctionnait samedi et plus maintenant ?
17 réponses
Denys
Bonjour =E0 tous,
J'essaie de copier de l'information depuis un classeur d=E9j=E0 ouvert.
Quelqu'un m'a propos=E9 d'activer dans la biblioth=E8que de r=E9f=E9rence 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=E8s bien et j'allais chercher de l'info sur
un fichier d=E9j=E0 ouvert. Aujourd'hui, rien =E0 faire, Excel me r=E9pond =
que
le "Microsoft Jet database engine cannot open the file" parce que
fichier est d=E9j=E0 ouvert et que je n'y ai pas acc=E8s.
J'ai v=E9rifi=E9, la r=E9f=E9rence est toujours coch=E9e....
Voici le code en question...
'Must have the Microsoft Activex Data Objects 2.0 Library
'in the tools----reference---in the VBA section (chang=E9 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 =3D New ADODB.Connection
If TTL =3D True Then HDR =3D "Yes" Else HDR =3D "No"
myConn.Open "Provider=3DMicrosoft.Jet.OLEDB.4.0;" & _
"Data Source=3D" & srcFile & ";" & _
"Extended Properties=3D""Excel 8.0;" & _
"HDR=3D" & HDR & ";IMEX=3D1;"""
Set myCmd =3D New ADODB.Command
myCmd.ActiveConnection =3D myConn
If srcSheet =3D "" _
Then myCmd.CommandText =3D "SELECT * from `" & srcRange & "`" _
Else myCmd.CommandText =3D "SELECT * from `" & srcSheet & "$" &
srcRange & "`"
Set myRS =3D 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 =3D 1 To myRS.RecordCount 'lignes
For RS_f =3D 0 To myRS.Fields.Count - 1 'colonnes
Arr(RS_n, RS_f + 1) =3D myRS.Fields(RS_f).Value
Next
myRS.MoveNext
Next
Loop
myConn.Close
Set myRS =3D Nothing
Set myCmd =3D Nothing
Set myConn =3D Nothing
outArr =3D Arr
End Sub
Si quequ'un y comprend quelque chose, cela m'aiderait beaucoup....
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" a écrit dans le message de news:
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
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" <denys.perreault@rbc.com> a écrit dans le message de news:
1193784412.773117.45500@50g2000hsm.googlegroups.com...
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....
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" a écrit dans le message de news:
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
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" wrote:
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 ?
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" <michde...@hotmail.com> wrote:
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 ?
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" wrote:
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
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
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....
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
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")
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
'é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" a écrit dans le message de news:
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
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")
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
'é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" <denys.perreault@rbc.com> a écrit dans le message de news:
1193798177.546311.145200@k79g2000hse.googlegroups.com...
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....
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")
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
'é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" a écrit dans le message de news:
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
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" a écrit dans le message de news: 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")
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
'é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" a écrit dans le message de news:
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
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" <michdenis@hotmail.com> a écrit dans le message de news:
uT6$Cx2GIHA.5228@TK2MSFTNGP05.phx.gbl...
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")
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
'é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" <denys.perreault@rbc.com> a écrit dans le message de news:
1193798177.546311.145200@k79g2000hse.googlegroups.com...
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....
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" a écrit dans le message de news: 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")
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
'é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" a écrit dans le message de news:
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
Bonjour Denis,
Merci beaucoup, je m'y mets dès ce matin et je te reviens...
Bonne journée
Denys
Bonjour Denis,
Merci beaucoup, je m'y mets dès ce matin et je te reviens...
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" wrote:
Qu'as-tu utiliser comme procédure ?
"Denys" a écrit dans le message de news:
Bonjour Denis,
Cette fois-ci, c'est parfait...
Merci infiniment
Denys
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" <michde...@hotmail.com> wrote:
Qu'as-tu utiliser comme procédure ?
"Denys" <denys.perrea...@rbc.com> a écrit dans le message de news:
1193850500.865967.106...@q3g2000prf.googlegroups.com...
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...
