Microsoft 365 [VBA] Créer un répertoire depuis une liste

[M92_]

Bonjour le fil,

Sauriez-vous comment peut-on nous servir de l'instruction MkDir de VBA pour créer une arborescence de dossiers/sous-dossiers (dans mon disque local) depuis une liste Excel, svp ?

J'ai par exemple un classeur/feuille qui contient quatre colonnes et j'aimerai pouvoir créer un dossier racine "METROPOLE" qui portera l'ensemble des sous-dossiers présents dans les colonnes B, C et D. Un petit détail : La colonne A pourrait éventuellement contenir d'autres valeurs (DOM-TOM, ..).

Merci par avance de votre aide précieuse,

Cdlt,
M92

 

[sylvanu]

Bonjour M92,
D'après ce que j'ai compris, vous voulez créer les dossiers et sous dossiers sur disque ?
( L'image de droite semble indiquer que vous voulez un dessin de l'architecture sur une feuille. )
Si c'est bien le cas, un essai en PJ avec :

Sub CreateDir()
    Dim Nom$, Dossier$, L%
    ' Mettre ici le chemin du dossier de tête
    Nom = "C:\Users\PC_PAPA\Desktop\M92"
    ' Création dossier de tête s'il n'existe pas
    If Len(Dir(Nom, vbDirectory)) = 0 Then MkDir Nom
    ' Création des sous dossiers
    For L = 2 To Cells(65000, "A").End(xlUp).Row
        Dossier = Nom & "\" & Cells(L, "A")
        If Len(Dir(Dossier, vbDirectory)) = 0 Then MkDir Dossier    ' Niveau 1
        Dossier = Dossier & "\" & Cells(L, "B")
        If Len(Dir(Dossier, vbDirectory)) = 0 Then MkDir Dossier    ' Niveau 2
        Dossier = Dossier & "\" & Cells(L, "C")
        If Len(Dir(Dossier, vbDirectory)) = 0 Then MkDir Dossier    ' Niveau 3
        Dossier = Dossier & "\" & Cells(L, "D")
        If Len(Dir(Dossier, vbDirectory)) = 0 Then MkDir Dossier    ' Niveau 4
    Next L
End Sub

Il vous faut modifier le Nom en fonction de l'emplacement désiré du dossier et de son nom.
On obtient avec votre fichier :

 

[M92_]

Bonjour M92,
D'après ce que j'ai compris, vous voulez créer les dossiers et sous dossiers sur disque ?
( L'image de droite semble indiquer que vous voulez un dessin de l'architecture sur une feuille. )
Si c'est bien le cas, un essai en PJ avec :

Sub CreateDir()
    Dim Nom$, Dossier$, L%
    ' Mettre ici le chemin du dossier de tête
    Nom = "C:\Users\PC_PAPA\Desktop\M92"
    ' Création dossier de tête s'il n'existe pas
    If Len(Dir(Nom, vbDirectory)) = 0 Then MkDir Nom
    ' Création des sous dossiers
    For L = 2 To Cells(65000, "A").End(xlUp).Row
        Dossier = Nom & "\" & Cells(L, "A")
        If Len(Dir(Dossier, vbDirectory)) = 0 Then MkDir Dossier    ' Niveau 1
        Dossier = Dossier & "\" & Cells(L, "B")
        If Len(Dir(Dossier, vbDirectory)) = 0 Then MkDir Dossier    ' Niveau 2
        Dossier = Dossier & "\" & Cells(L, "C")
        If Len(Dir(Dossier, vbDirectory)) = 0 Then MkDir Dossier    ' Niveau 3
        Dossier = Dossier & "\" & Cells(L, "D")
        If Len(Dir(Dossier, vbDirectory)) = 0 Then MkDir Dossier    ' Niveau 4
    Next L
End Sub

Il vous faut modifier le Nom en fonction de l'emplacement désiré du dossier et de son nom.
On obtient avec votre fichier :
Regarde la pièce jointe 1120739

Bonjour @sylvanu,

Votre solution répond parfaitement à mon besoin (créer des dossiers/sous-dossiers sur un disque local).
J'ai changé la valeur de la variable "Nom", ai lancé la macro et l'arborescence a bien été créée. C'est vraiment super !

J'ai néanmoins une question :

Maintenant, que l'arborescence est créée sur mon disque, et suivant le scénario suivant :

1. Je mets des fichiers (de type divers), dans chaque dossier de cette arborescence,
2. Je rajoute des lignes dans mon tableau (pour intégrer d'autres zones/rég/dép/villes)
3. Je relance la macro

Que se passerait-il exactement dans ce cas ? Les nouvelles lignes seront-elles traitées ?
Et le plus important, le contenu des dossiers/sous-dossiers créés précédemment sera-t-il écrasé ?

Encore une chose, serait-il possible de modifier la macro pour que trois dossiers (portant les noms, GROUPE | LOT | GEOGRAPHIE) puissent être créées systématiquement dans les dossiers de niveau 4 (les villes) ?

Merci beaucoup,

Cdlt,
M92

 

[sylvanu]

If Len(Dir(Dossier, vbDirectory)) = 0 Then MkDir Dossier

Cette ligne regarde si "Dossier" existe.
S'il existe il ne fait rien, donc ne touche à rien. S'il n'existe pas il le crée.
Donc vous pouvez rajouter de nouvelles lignes elles seront traitées en conséquence.
Par contre si vous "bidouillez" les noms sous l'explorateur alors il peut y avoir des soucis.
Par ex si vous changer le nom du dossier GALIE en GALLIE sous Windows, alors la macro ne trouvant pas GALIE va créer le dossier.
Cela semble évident mais je préfère le préciser.

 

[sylvanu]

Pour le second point, voir PJ. J'ai modifié le niveau 4 avec :

        Dossier = Dossier & "\" & Cells(L, "D")
        If Len(Dir(Dossier, vbDirectory)) = 0 Then
            MkDir Dossier    ' Niveau 4
            MkDir Dossier & "\GROUPE"     ' Crétion automatique des trois dossiers
            MkDir Dossier & "\LOT"
            MkDir Dossier & "\GEOGRAPHIE"
        End If

Par contre les trois dossiers créés ne le sont que si la directory n'existe pas puisque je ne touche jamais aux directories qui existent.
Mais comme vous êtes au début, il vous suffit de ré initialiser le dossier pour que ça marche sans problème.

 

[M92_]

Pour le second point, voir PJ. J'ai modifié le niveau 4 avec :

        Dossier = Dossier & "\" & Cells(L, "D")
        If Len(Dir(Dossier, vbDirectory)) = 0 Then
            MkDir Dossier    ' Niveau 4
            MkDir Dossier & "\GROUPE"     ' Crétion automatique des trois dossiers
            MkDir Dossier & "\LOT"
            MkDir Dossier & "\GEOGRAPHIE"
        End If

Par contre les trois dossiers créés ne le sont que si la directory n'existe pas puisque je ne touche jamais aux directories qui existent.
Mais comme vous êtes au début, il vous suffit de ré initialiser le dossier pour que ça marche sans problème.

Justement, ça m'arrange que ces trois dossiers ne soient pas créées au cas où le dossier/ville n'existe pas.

Vous venez de me faire gagner des heures de travail.

Un grand merci !

Cdlt,
M92

 

[sylvanu]

Justement, ça m'arrange que ces trois dossiers ne soient pas créées au cas où le dossier/ville n'existe pas.

Euh !!! J'ai dit le contraire;
Si le dossier ville n'existe pas, je le créé et dedans je met les trois dossiers Groupe, Lot, Géographie.
Si le dossier existe alors je ne touche à rien.

 

[M92_]

Euh !!! J'ai dit le contraire;
Si le dossier ville n'existe pas, je le créé et dedans je met les trois dossiers Groupe, Lot, Géographie.
Si le dossier existe alors je ne touche à rien.

Ça n'est pas un problème, c'est moi qui suis mal exprimé !
Tant que le contenu (fichiers, images,.. ) des dossiers ne sera jamais modifié, je suis à l'abri !

Bonne journée,

Cdlt,
M92

 

[mehdijz]

Bonjour, merci pour la réponse simple et efficace , par contre est-il possible de mettre un filtre dans le macro avant de créer les dossiers?

A	T	Nom	Prénom
1044​	#N/A​	DR	CL
1024​	2078827​	HA	T

cad lorsque il trouve N/A dans la colonne T il ne crée pas de dossier et s'il trouve des chiffres il fait la création.

Merci pour votre aide

 

[sylvanu]

Bonjour Mehdijz,
Etes vous sur d'être sur le bon fil ?
Car votre question n'a rien à voir avec ce post. De quel filtre parlez vous ? Quel dossier à créer ?

 

[mehdijz]

Bonjour, oui je suis sur le bon fil , le dossier a créer s'appel :1024_HA T
donc si le macro trouve dans la colonne T (N/A) il doit pas faire la création du dossier 1024_DR CL

Bonjour Mehdijz,
Etes vous sur d'être sur le bon fil ?
Car votre question n'a rien à voir avec ce post. De quel filtre parlez vous ? Quel dossier à créer ?

 

[sylvanu]

Utilisez "iserreor" pour ne pas le traiter :

Cellule=.... ' à renseigner
If Not IsError(cellule.Value) Then
    Créer dossier
End If

Si la cellule n'est pas en erreur, on crée le dossier, sinon on passe à la ligne suivante.

 

[mehdijz]

voila mon code , je n'ai pas compris comment j'intègre ta réponse
PS: je suis débutant en VBA, j'essaye de me débrouillé toute seule sur internet

Sub CreateDir()
Dim Nom$, Dossier$, L%
Dim ws_data As Worksheet
Set ws_data = Worksheets(1)

' Mettre ici le chemin du dossier de tête
Nom = "C:\Users\mmjenzri\OneDrive - Sopra Steria\Desktop\TEST"
' Création dossier de tête s'il n'existe pas
If Len(Dir(Nom, vbDirectory)) = 0 Then MkDir Nom
' Création des sous dossiers
For L = 2 To Cells(65000, "A").End(xlUp).Row

Dossier = Nom & "\" & Cells(L, "B") & "_" & ws_data.Cells(L, 9) & "_" & ws_data.Cells(L, 10)
If Len(Dir(Dossier, vbDirectory)) = 0 Then MkDir Dossier ' Niveau 1
Dossier = Dossier & "\" & "Documents de sortie"
If Len(Dir(Dossier, vbDirectory)) = 0 Then MkDir Dossier ' Niveau 2
Dossier = Dossier & "\" & Cells(L, "C")

Next L
End Sub

Merci pour ta réponse rapide ainsi que pour ton aide =)

 

[sylvanu]

Re,
Utilisez les balises </> pour le code, c'est plus lisible ( à droite de l'icone GIF )
Et indentez votre code, là aussi c'est plus lisible.

Si l'erreur est en colonne B alors testez :

Sub CreateDir()
    Dim Nom$, Dossier$, L%
    Dim ws_data As Worksheet
    Set ws_data = Worksheets(1)
    ' Mettre ici le chemin du dossier de tête
    Nom = "C:\Users\mmjenzri\OneDrive - Sopra Steria\Desktop\TEST"
    ' Création dossier de tête s'il n'existe pas
    If Len(Dir(Nom, vbDirectory)) = 0 Then MkDir Nom
    ' Création des sous dossiers
    For L = 2 To Cells(65000, "A").End(xlUp).Row
        If Not IsError(Cells(L, "B")) Then
            Dossier = Nom & "\" & Cells(L, "B") & "_" & ws_data.Cells(L, 9) & "_" & ws_data.Cells(L, 10)
            If Len(Dir(Dossier, vbDirectory)) = 0 Then MkDir Dossier ' Niveau 1
            Dossier = Dossier & "\" & "Documents de sortie"
            If Len(Dir(Dossier, vbDirectory)) = 0 Then MkDir Dossier ' Niveau 2
            Dossier = Dossier & "\" & Cells(L, "C")
        End If
    Next L
End Sub

 

[kiki29]

Salut, à titre de curiosité voir sur Boisgontier