Adapter macro .xls -- .xlsx

Version imprimable

Bonsoir à tous,

J'ai trouvé sur ce forum un bout de code merveilleux, qui correspond parfaitement à ce qu'il me fallait, sauf sur un petit détail :

En effet, je voulais une macro, qui me permet de récupérer toutes les infos de différents classeur excel qui sont situés dans le même répertoire, afin de le coller dans un fichier "base de données".

J'ai trouver celle là
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 'Nécessite d'activer la référence 'Microsoft ActiveX Data Objects x.x Library Dim Cn As ADODB.connection Dim Rs As ADODB.Recordset Dim xConnect As String, Cible As String Dim Fichier As String, Dossier As String, Feuille As String Dim i As Long 'nom du répertoire contenant les classeurs à regrouper Dossier = "D:\Boulot\Argent_poche_SNR\Tableau_de_bord" 'Nom de la feuille dans les classeurs fermés 'Ne pas oublier le symbole $ après le nom de la feuille Feuille = "Feuil1$" i = 2 Fichier = Dir(Dossier & "\*.xls") 'boucle sur les fichiers du repertoire Do While Len(Fichier) > 0 xConnect = "DRIVER={Microsoft Excel Driver (*.xls)};" & _ "ReadOnly=1;DBQ=" & Dossier & "\" & Fichier 'connection classeur Set Cn = New ADODB.connection Cn.Open xConnect 'Requete Cible = "SELECT * FROM [" & Feuille & "];" Set Rs = New ADODB.Recordset Rs.Open Cible, xConnect, adOpenStatic, adLockOptimistic, adCmdText 'Ecriture dans la feuille de calcul If Not Rs.EOF Then Cells(i, 1).CopyFromRecordset Rs i = Cells(i, 1).End(xlDown).Row + 1 Rs.Close Cn.Close Set Cn = Nothing Set Rs = Nothing Fichier = Dir() Loop MsgBox "Terminé"
mais elle marche pour les fichiers .xls. Y'a t-il moyen de la transformer pour faire fonctionner les fichiers .xlsx ?

J'ai des connaissances en macro, mais peu sur le fonctionnement des connexions entre classeurs. J'ai essayé de lire le tuto de silkyroad, mais le type de connexion n'étant pas tout à fait pareil, je suis perdu ...

j'ai tenté bêtement de changer les .xls en .xlsx dans la macro, mais j'ai une erreur "gestionnaire de pilote ODBC source de donnée introuvable, et nom de pilote non spécifié"

je vous remercie d'avance,

charles

Salut

Fait un essai comme cela

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
Sub testODBC()
'Nécessite d'activer la référence
    'Microsoft ActiveX Data Objects x.x Library
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim xConnect As String, Cible As String
Dim Fichier As String, Dossier As String, Feuille As String
Dim i As Long
 
'nom du répertoire contenant les classeurs à regrouper
Dossier = "D:\Boulot\Argent_poche_SNR\Tableau_de_bord"
'Nom de la feuille dans les classeurs fermés
'Ne pas oublier le symbole $ après le nom de la feuille
Feuille = "Feuil1$"
i = 2
 
Fichier = Dir(Dossier & "\*.xlsx")
'boucle sur les fichiers du repertoire
Do While Len(Fichier) > 0
    xConnect = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
    "ReadOnly=1;DBQ=" & Dossier & "\" & Fichier
    'connection classeur
    Set Cn = New ADODB.Connection
    Cn.Open xConnect
 
    'Requete
    Cible = "SELECT * FROM [" & Feuille & "];"
 
    Set Rs = New ADODB.Recordset
    Rs.Open Cible, xConnect, adOpenStatic, adLockOptimistic, adCmdText
 
    'Ecriture dans la feuille de calcul
    If Not Rs.EOF Then Cells(i, 1).CopyFromRecordset Rs
    i = Cells(i, 1).End(xlDown).Row + 1
 
    Rs.Close
    Cn.Close
    Set Cn = Nothing
    Set Rs = Nothing
    Fichier = Dir()
Loop
End Sub

++
Qwaz

18/01/2015, 22h03
kiki29

Salut, un peu de lecture suffit : ici
18/01/2015, 22h07
Traputaca

YES !

Sa marche !

Alors, juste parce qu'il y a (*.xls, *.xlsx, *.xlsm, *.xlsb) au lieu de mon simple (*.xlsx) !?

en tout cas sa marche, c'est TIP TOP !

Je te remercie de la rapidité !

KIKI29, j'ai lu cette page là comme je l'ai souligné, mais cela ne m'a pas permis de résoudre mon problème.

dans le tuto il est utilisé tous le temps "Driver={Microsoft Excel Driver (*.xls)}" il n'était pas évident (du moins pour ma part), que (*.xls, *.xlsx, *.xlsm, *.xlsb) allait marcher au lieu d'un simple (*.xlsx)
19/01/2015, 06h17
Qwazerty

Salut

Pour info c'est le nom du pilote donc si tu écrits "tintin" au lieu de "toto", ça ne marche pas.
Pour info bis, je n'ai rien inventé, j'ai juste taper ODCB xlsx sur google ;), google est ton ami...enfin dans une certaine mesure ;)

++
Qwaz