Discussion :

[Traputaca]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Qwazerty]

Salut

Fait un essai comme cela

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[kiki29]

Salut, un peu de lecture suffit : ici

[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)

[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