Création dossiers imbriqués

[bambi]

Bonjour à tous

A partir de noms dans un fichier excel, je tente de créer par macro 264 dossiers aux noms différents
Chaque dossiers contient 2 sous-dossiers tous identiques au nom de "Pommes" et "Poires"
Chaque sous-dossiers contient à son tour 2 sous-sous dossiers tous identiques au nom de "Prix" et "Quantité"

J'ai essayé d"adapter une macro trouvée ici
J'arrive à créer les 264 dossiers aux noms différents et les sous-dossiers Pommes et Poires à l’intérieur
Mais pas les sous-sous dossiers "Prix" et "Quantité" dans les dossiers Pommes et Poires

Merci de votre aide

Sub CreationRepert()
    On Error Resume Next
    i = 1
    While Cells(i, 1).Value <> ""
        MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value
        For j = 2 To 3
            MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value
        Next j
        For k = 4 To 5
            MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value & "\" & Cells(j, k).Value
        Next k
        i = i + 1
    Wend
End Sub

 

[sousou]

Re : Création dossiers imbriqués

Bonjour
en utilisant l'objet filesystem
voila ce que tu peux faire:
Ici les données ont feuil1 colonne 1 et les répertoire sont créés dans le répertoire du fichier excel
Sub deb()
chemin = ThisWorkbook.Path
Set zone = zc(Sheets("feuil1"), 1, 1)

Set fso = CreateObject("scripting.filesystemobject")
For Each i In zone
Set rep = fso.createfolder(chemin & "/" & i.Value)

Set reppomme = fso.createfolder(rep.Path & "\pommes")
Set reppoire = fso.createfolder(rep.Path & "\poires")
fso.createfolder (reppomme.Path & "\prix")
fso.createfolder (reppomme.Path & "\quantités")
fso.createfolder (reppoire.Path & "\prix")
fso.createfolder (reppoire.Path & "\quantités")

Next

End Sub

 

[bambi]

Re : Création dossiers imbriqués

Merci sousou de t’intéresser à ma question
mais à quoi correspond zc dans Set zone = zc(Sheets("feuil1"), 1, 1)
Car j'ai une erreur de compilation

 

[bambi]

Re : Création dossiers imbriqués

Une image de l'erreur

 

[bambi]

Re : Création dossiers imbriqués

je n'ai pas réussi à trouver l'erreur dans la macro de sousou

Je remet mon fichier avec en module 1, ma macro initiale du 1er message de cette file
Mais elle ne fonctionne pas pour les sous-sous dossiers

Et en module 2, la macro de sousou avec une erreur de compilation


Merci d'avance de votre aide

 

[cathodique]

Re : Création dossiers imbriqués

Bonjour,

essaies ceci

Sub deb()

chemin = ThisWorkbook.Path

Set zone = Sheets("Feuil1").Range("A1").CurrentRegion
Set fso = CreateObject("scripting.filesystemobject")
For Each i In zone
On Error Resume Next
Set Rep = fso.createfolder(chemin & "/" & i.Value)

Set reppomme = fso.createfolder(Rep.Path & "\pommes")
Set reppoire = fso.createfolder(Rep.Path & "\poires")
fso.createfolder (reppomme.Path & "\prix")
fso.createfolder (reppomme.Path & "\quantités")
fso.createfolder (reppoire.Path & "\prix")
fso.createfolder (reppoire.Path & "\quantités")

Next

End Sub

Attention! avec ce code si les dossiers existent déjà, ils seront tous écrasées.
Je ne connais pas la méthode fso, j'ai simplement corrigé l'erreur de sousou.

 

[bambi]

Re : Création dossiers imbriqués

Merci beaucoup cathodique
ça fonctionne parfaitement

 

[sousou]

Re : Création dossiers imbriqués

Bonjour à tous
désolé, pour le zc! cette une fonction que j'utilise et que j'ai oublié de te fournir, mais sont résultat est, dans ton cas, la même chose
que la première ligne de cathodique
Set zone = Sheets("Feuil1").Range("A1").CurrentRegion

 

[bambi]

Re : Création dossiers imbriqués

Pas grave du tout sousou. Bonne journée et encore merci à vous deux pour votre aide