Importer data d'un fichier excel sous Windows 7 et Excel 2010

Le
Denys
Bonjour à tous,

Depuis plusieurs années, l'usager clique sur un bouton dans un fichier ex=
cel 2003 et avec la macro qui suit importe les données d'un autre fichier=
sans problèmes et de façon très rapide. Cette macro ne fonctionne pl=
us sous Excel 2010. Quelqu'un connaitrait la réponse ?

Voici la macro avec les détails.

Sub LitEmployee()
Dim Msg, Style, Title, Fichier As String
Fichier = "\maple.comdatamontrealtransitp01111b0DenysExcel 2010" =
& ActiveSheet.Range("B1").Value & ".xlsm"


If IsFileOpen(Fichier) Then
MsgBox "" & ActiveSheet.Range("B1").Value & "'s file is already in use"=
& Chr(13) & "Please try later"
Exit Sub
End If
Dim Fich$, Arr
Fich = ""\maple.comdatamontrealtransitp01111b0DenysExcel 2010" =
& ActiveSheet.Range("B1").Value & ".xlsm"

'récup des données à partir de l'adresse d'une plage de cellules
GetExternalData Fich, "Daily tasks", "A1:E5000", False, Arr

'récup des données à partir du nom d'une plage de cellules ()
'GetExternalData Fich, "", "Tout", False, Arr

With ActiveSheet
.Range("A1", .Cells(UBound(Arr, 1), UBound(Arr, 2))).Value = Arr
End With

End Sub


'Must have the Microsoft Activex Data Objects 2.0 Library
'in the tools-referencein the VBA section
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 Intege=
r
Dim Arr



Set myConn = New ADODB.Connection
If TTL = True Then HDR = "Yes" Else HDR = "No"

Excel bug ici..et je ne sais pas pourquoi.

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 & "$" & srcRang=
e & "`"
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


Merci pour votre temps

Denys
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Denys
Le #26100632
Bon....

Il semblerait que le code suivant résoud les probèmes....

myConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & srcFile & ";" & _
"Extended Properties=""Excel 12.0;" & _
"HDR=" & HDR & ";IMEX=1;"""

Ca a fonctionné pour une application.....
Je teste les autres et reviens si je ne suis pas chanceux....

Merci

Denys
MichD
Le #26100622
Bonjour,

Tu as un message d'erreur? Si oui, quel est-il?

Dans ton code, il est écrit :
'Must have the Microsoft Activex Data Objects 2.0 Library

Tu pourrais majorer pour
'Must have the Microsoft Activex Data Objects 2.8 Library

Change ceci :
myConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & srcFile & ";" & _
"Extended Properties=""Excel 8.0;" & _
"HDR=" & HDR & ";IMEX=1;"""

POUR :

Est-ce bien cette ligne de code qui est problématique?
myConn.Open = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & srcFile & ";" & _
"Extended Properties=""Excel 12.0; "HDR=" & HDR & ";IMEX=1;"""

As-tu toujours le même problème?
Denys
Le #26100682
Bonjour Denis

Tu as exactement trouvé ce qui n'allait pas...

Tout fonctionne bien maintenant

Bonne fin de journée

Denys
Denys
Le #26100672
Le jeudi 24 avril 2014 15:19:23 UTC-4, Denys a écrit :
Bonjour Denis Tu as exactement trouvé ce qui n'allait pas... Tout fonct ionne bien maintenant Bonne fin de journée Denys



Merci beaucoup :-)
Publicité
Poster une réponse
Anonyme