Discussion :

[MalorieV]

Bonjour,

Veuillez m'excuser de revenir sur ce sujet apparement résolu, mais j'ai strictement le même problème et je n'arrive pas à m'en dépétrer :S
J'aimerai pouvoir ouvrir l'ensemble des fichier csv contenus dans un dossier et ses sous dossier et les enregistrer au même endroit en .xlsx

En gros, j'ai un dossier principal dont je connais le chemin

Dans ce dossier il y a à la fois des fichiers CSV et des sous dossiers

Dans ces sous dossiers il y a à la fois des fichiers CSV et des sous-sous dossiers

Dans les sous-sous dossiers il y a des fichiers CSV

Je voudrai pouvoir ouvrir automatiquement par une macro, TOUS les fichiers CSV contenus dans l'intégralié de l'arborescence descendante du dossier principal et les enregistrer en .xlsx

D'ailleurs, je n'ai même pas besoin de les ouvrir, je veux juste les convertir en xlsx et les enregistrer au même endroit



Si vous avez un peu plus d'infos que données précédement, je suis toute ouïe !

Merci d'avance !

[Theze]

Bonsoir,

Une piste. Adapter le chemin du dossier cible dans la proc "test". Les classeurs ".cvs" sont conservés mais il peuvent être détruit avec Kill une fois refermés. A mettre dans un module standard :

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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
 
Dim J As Integer
Dim Racine As Boolean
 
Sub test()
 
    Dim tbl() As String
    Dim Cls As Workbook
    Dim I As Integer
 
    J = 0
    Racine = True
 
    tbl() = RecupFichiers("E:\Mon Dossier\", ".csv") 'adapte le chemin
 
    If Not (Not tbl) Then
 
        For I = 1 To UBound(tbl)
 
            Set Cls = Workbooks.Open(tbl(I))
            Cls.SaveAs Left(tbl(I), InStrRev(tbl(I), ".") - 1), xlNormal
            Cls.Close
 
        Next I
 
    End If
End Sub
 
 
Function RecupFichiers(Dossier As String, Extension As String) As String()
 
    Dim Tablo() As String
    Dim FSO As Object
    Dim Dos As Object
    Dim Fichier As Object
    Dim I As Integer
    Static DossierRacine As String
 
    'supprime le "\" de fin
    If Right(Dossier, 1) = "\" Then Dossier = Left(Dossier, Len(Dossier) - 1)
 
    If DossierRacine = "" Then DossierRacine = Dossier
 
    'crée l'objet FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
 
    'si le dossier n'existe pas
    If FSO.FolderExists(Dossier) = False Then
 
        MsgBox "Le dossier portant ce nom n'existe pas !"
        Exit Function
 
    End If
 
    'si c'est le dossier racine
    If Racine = True Then
 
        'récupère les fichiers contenus dans le dossier racine
        For Each Fichier In FSO.GetFolder(Dossier).Files
 
            If Mid(Fichier, InStr(Fichier, ".")) Like Extension & "*" Then
 
                J = J + 1
                ReDim Preserve Tablo(1 To J)
                Tablo(J) = Fichier
 
            End If
 
        Next Fichier
 
        Racine = False
 
    End If
 
    'si c'est le lecteur, il n'y a pas de "\" donc, I doit être à 1 pour colonne A
    If InStr(Dossier, "\") = 0 Then I = 1 Else I = 0
 
    'boucle sur les dossiers
    For Each Dos In FSO.GetFolder(Dossier).SubFolders
 
        I = I + 1
 
        'évite l'erreur des fichiers interdits
        On Error Resume Next
 
        'récupère les fichiers contenus dans le dossier en cours
        For Each Fichier In Dos.Files
 
            If Mid(Fichier, InStr(Fichier, ".")) Like Extension & "*" Then
                J = J + 1
                ReDim Preserve Tablo(1 To J)
                Tablo(J) = Fichier
            End If
 
        Next Fichier
 
        'rappel de la proc pour chercher les dossiers enfants
        RecupFichiers Dossier & "\" & Dos.Name, Extension
 
    Next Dos
 
    RecupFichiers = Tablo()
 
End Function