problème avec ADO

Dim myConn As ADODB.Connection
'
'
'
Public Sub OpenConnection_read(SrcFile As String, TTL As Boolean)
'
'
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;"""
'
'
End Sub
Public Sub CloseConnection_read()
'
' Ferme la connexion ouverte à la feuille Excel
'
myConn.Close
Set myConn = Nothing
'
'
End Sub
Public Sub GetExternalData(srcSheet As String, srcRange As String, outArr As Variant)
'
'
' Cherche les valeurs d'une plage de cellules dans un classeur fermé
'
'
Dim myCmd As ADODB.Command
Dim HDR As String, myRS As ADODB.Recordset, RS_n As Integer, RS_f As Integer
Dim arr
'
'
Set myCmd = New ADODB.Command
myCmd.ActiveConnection = myConn
If srcSheet = "" Then
myCmd.CommandText = "SELECT * from `" & srcRange & "`"
Else
myCmd.CommandText = "SELECT * from `" & srcSheet & "$" & srcRange & "`"
End If
'
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
'
Set myRS = Nothing
Set myCmd = Nothing
'
'
outArr = arr
'
End Sub

Bonjour Wawa,

Ton code devrait fonctionner correctement.

Je te suggère de regarder à cette adresse et de mettre à jour la dernière version Microsoft Jet 4.0 Database Engine

http://support.microsoft.com/kb/239114/en-us


Salutations!



"Wawa.voum" <"pas.de@spams.ici.fr"> a écrit dans le message de news: 4231e892$0$826$8fcfb975@news.wanadoo.fr...
Bonjour la Planète,

Un petit problème avec Excel et VBA :

Cas 1 :

Windows 2000 pro + Office 2000

Pas de problème pour lire des données dans un fichier Excel fermé.
J'utilise une connexion ActiveX Data Object ( version 2.5) avec le
provider Microsoft Jet.

Cas 2 :

En environnement Windows 2003 + Office 2003 il n'y a rien à faire,
l'établissement de la connexion échoue.
Bien sur la référence à ADO 2.5 est activée dans le projet VBA.

Je suis sec, je ne trouve pas ce qui ne va pas....C'est pas un problème
de droit, c'est pareil en administrateur.

Ca plante à la ligne "myConn.Open....."

Merci beaucoup pour toute suggestion ou début de piste....

Philippe


Le code utilisé est ci dessous :

Dim myConn As ADODB.Connection
'
'
'
Public Sub OpenConnection_read(SrcFile As String, TTL As Boolean)
'
'
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;"""
'
'
End Sub
Public Sub CloseConnection_read()
'
' Ferme la connexion ouverte à la feuille Excel
'
myConn.Close
Set myConn = Nothing
'
'
End Sub
Public Sub GetExternalData(srcSheet As String, srcRange As String, outArr As Variant)
'
'
' Cherche les valeurs d'une plage de cellules dans un classeur fermé
'
'
Dim myCmd As ADODB.Command
Dim HDR As String, myRS As ADODB.Recordset, RS_n As Integer, RS_f As Integer
Dim arr
'
'
Set myCmd = New ADODB.Command
myCmd.ActiveConnection = myConn
If srcSheet = "" Then
myCmd.CommandText = "SELECT * from `" & srcRange & "`"
Else
myCmd.CommandText = "SELECT * from `" & srcSheet & "$" & srcRange & "`"
End If
'
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
'
Set myRS = Nothing
Set myCmd = Nothing
'
'
outArr = arr
'
End Sub