Discussion :

[Liks71]

Bonjour,

J'ai déjà créé à l'aide des ressources à ma disposition plusieurs petites applications en VBA, rien de bien méchant mais qui comme chacun sait, facilite grandement la vie.

Aujourd'hui je cherche le moyen de compiler plusieurs fichiers excel en un seul. en farfouillant sur le web j'ai trouvé le code suivant :

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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
 
Sub compiler()
 
 
'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
Dim emplacement As String
 
'la série à traiter. <<============ Ajouter par mes soins
emplacement = InputBox("Quelle série dois-je traiter ?" & Chr(10) & Chr(10) & "Indiquer la série : ", "Série en cours de traitement", "01")
'petit test pour éviter les soucis d'incohérence.
If Len(emplacement) <> 2 Then
    MsgBox "Vous avez fait une erreur ! La série doit être renseignée avec 2 caractères ! (Exemple pour la semaine 4 saisir : 04)"
    emplacement = InputBox("Quelle série dois-je traiter ?" & Chr(10) & Chr(10) & "Indiquer la série : ", "Série en cours de traitement", "01")
    If Len(emplacement) <> 2 Then
        MsgBox "Série incorrect à nouveau, veuillez relancer la commande svp..."
        Exit Sub
    End If
End If
 
 
'nom du répertoire contenant les classeurs à regrouper
Dossier = "C:\Documents and Settings\plancher\Bureau\test_quinc\" & emplacement & "\"
'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
 
'permet de ne pas cumuler plusieurs fois les mêmes nomenclatures
Range("A2:L100").Delete
 
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 "Réception des fichiers excel terminée."
End Sub

Au vue des commentaires et de mes premiers essais il semble fonctionner parfaitement.

Hélas il ne copie pas parfaitement. en effet bien que ce soit via une requête il manque certaines cases de certaines lignes. Ainsi il se peut qu'il copie dans le fichier de destination le premier fichier parfaitement et qu'au second la ligne 6 colonne 4 se retrouve vide alors qu'elle ne l'est pas etc..

Je ne vois pas d'où cela peut-il venir, ni ce que je peux y faire pour que cela fonctionne bien.

Je vous remercie d'avance, et si vous avez besoin d'un exemple concret et/ou d'information supplémentaire n'hésitez pas à me les demander =)

[Invité]

bonjour,

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
43
44
45
46
47
48
49
50
51
52
53
 
Sub compiler()
'Nécessite d'activer la référence
'Microsoft ActiveX Data Objects x.x Library
Dim Cn As Object 'ADODB.Connection
Dim Rst As Object ' ADODB.Recordset
Dim xConnect As String, Cible As String
Dim Fichier As String, Dossier As String, Feuille As String
Dim i As Long
Dim emplacement As String
'la série à traiter. <<============ Ajouter par mes soins
emplacement = InputBox("Quelle série dois-je traiter ?" & Chr(10) & Chr(10) & "Indiquer la série : ", "Série en cours de traitement", "01")
'petit test pour éviter les soucis d'incohérence.
If Len(emplacement) <> 2 Then
    MsgBox "Vous avez fait une erreur ! La série doit être renseignée avec 2 caractères ! (Exemple pour la semaine 4 saisir : 04)"
    emplacement = InputBox("Quelle série dois-je traiter ?" & Chr(10) & Chr(10) & "Indiquer la série : ", "Série en cours de traitement", "01")
    If Len(emplacement) <> 2 Then
        MsgBox "Série incorrect à nouveau, veuillez relancer la commande svp..."
        Exit Sub
    End If
End If
'nom du répertoire contenant les classeurs à regrouper
Dossier = "C:\Documents and Settings\plancher\Bureau\test_quinc\" & emplacement & "\"
'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
'permet de ne pas cumuler plusieurs fois les mêmes nomenclatures
Range("A2:L100").Delete
Fichier = Dir(Dossier & "\*.xls")
'boucle sur les fichiers du repertoire
 'connection Dossier
Set Cn = CreateObject("ADODB.Connection")
Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Dossier & ";Extended Properties = text"
Do While Len(Fichier) > 0
    'Requete
    Cible = "SELECT * FROM [" & Feuille & "] in '" & Dossier & "\" & Fichier & "' 'excel 8.0;HDR=YES""' ;"
    Set Rs = CreateObject("ADODB.Recordset")
    Rs.Open Cible, Cn
    For c = 0 To Rs.fields.Count -1
        Range("A1").Offset(0, c) = Rs(c).Name
    Next
    'Ecriture dans la feuille de calcul
    Cells(i, 1).CopyFromRecordset Rs
    i = Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
    Rs.Close
    Set Rs = Nothing
    Fichier = Dir()
Loop
Cn.Close
Set Cn = Nothing
MsgBox "Réception des fichiers excel terminée."
End Sub

[Liks71]

Oh super merci =)

La curiosité me pousserait à te demander le pourquoi du comment histoire de ne pas mourir idiot.

Cela dit je ne suis pas sur de comprendre, et la solution directe me fait gagner un temps fou.

Merci beaucoup =)

Arf j'ai parlé trop vite.

Effectivement une partie des manquants est apparue. Mais certaines restent toujours absentes :s

[Invité]

je me connecte comme pour des fichier CSV/TXT! le répertoire devient un serveur!

Code :

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

Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Dossier & ";Extended Properties = text"

ensuite j'ouvre un RecordSet mais comme nous travaillons avec de fichier Excel je lui dit!

Code :

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

 Cible = "SELECT * FROM [" & Feuille & "] in '" & Dossier & "\" & Fichier & "' 'excel 8.0;HDR=YES""' ;"

ICI je donne le diver! et ICI je lui dit que la première ligne est le nom des champs RS(c).Name

dans ton fichier Excel, il doit y avoir des valeur de type texte et d'autre numérique! vue qu'ADO vérifie le type de champs (string; numérique;date) en se basant sur les 8 première ligne il doit pensé que c'est du numérique et place les valeur string à blanc, il faut lui dire que tu t'en fout!

Code :

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

 Cible = "SELECT * FROM [" & Feuille & "] in '" & Dossier & "\" & Fichier & "' 'excel 8.0;HDR=YES;IMEX = 1;""' ;"

[Liks71]

Merci pour ces explications.

Désolé mais ça ne fonctionne toujours pas même avec la ligne nouvellement modifiée.

[Invité]

peux tu placer un exemple de fichier en bidonnant le donnée, bien sur un exemple ou certaine données Apparaissent et d'autres non!

[Liks71]

quincaillerie.xls
test 655.xls
test 654.xls
test 656.xls

Oui aucun risque sur les données ce sont des fichiers de test avec de fausses pièces.

Le fichier quincaillerie.xls est celui qui regroupe les données des 3 autres sur la feuille 1, et en feuille 2 se trouve le traitement que je fais sur les données une fois importées.

petite précision les données manquantes se trouvent colonne 4 : REFERENCE.

[Invité]

la seule chose que j'ai trouvé, c'est:
1) formater la colonne dans test 654.xls au fromat text
2) modifier la base de registre
a) ouvrir regedite
b) sélectionner sur localmachine
c) rechercher ImportMixedTypes
d) passer TypeGuessRows à 0 pour que la recherche de type ce face sur tout la colonne!

https://support.microsoft.com/fr-fr/kb/257819

[Liks71]

et il n'est pas possible de lui dire que tout ce qu'il importe est forcément au format texte ?

Car derrière je teste les caractères donc ça ne poserait aucun soucis pour moi.

[Invité]

c'est bien ce que je lui dis là IMEX = 1!
mais il n'en tien pas compte?????§§§§§§

j'ai chercher ALTER table pour excel afin de changer son type direct par sql



ADODB ne veut que des champs type et par défaut c'est lui qui les type!

[Invité]

bonjour,
voilà ça marche, tu peux dires un grand merci à Docmarti.

Code :

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

Cible = "SELECT * FROM [" & Feuille & "] in '" & Dossier & "\" & Fichier & "' 'excel 8.0;HDR=YES;IMEX=1;""' ;"

[kiki29]

Salut, pour information, voir ici et adapter à ton contexte.

[Liks71]

Parfait super merci rdurupt et Docmarti !

Vous m'ôtez une belle épine du pied et aller permettre d'économiser au final l'équivalent de 2h de temps chaque semaine

kiki29 j'irai télécharger le dossier par curiosité pour voir les différences avec ce qui est déjà fait. Mais en dehors des heures de travail.

Bon courage et Merci encore.