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!