Creation de 2500 dossiers + sous dossiers identiques partout

Bonjour,

Voila j'ai chercher partout et les codes que je trouve ne fonctionne pas et je n'ai aucune connaissance en VBA donc je ne m'en sors pas du tout j'ai besoin d'aide.

J'ai 2500 dossiers à créer avec des nom tous différents (liste créée en colonne A d'un tableau excel) et dans chacun de ces dossiers je veux créer une arborescence de sous-dossier identique partout mais je n'arrive pas à trouver une solution sans avoir à faire une liste interminable dans excel à côté et sous chaque dossier.

Si quelqu'un peut m'aider svp.

L'arborescence voulue dans chacun des 2500 dossier est la suivante

puis la même arborescence que le dossier 2 jusqu'au dossier 6

Bonjour FatalitY et

Une petite présentation ICI serait la bienvenue

Si vous ne l'avez pas encore fait, je vous invite à lire :
- La charte du forum
- Quelques fonctionnalités du forum à connaître
qui vous aideront dans vos demandes et réponses sur ce forum.

Regardez aussi les petites icônes mises à votre disposition dans la barre de menu qui :
- vous permettent de poster un code (</>)
- ou de clôturer un fil lorsque vous avez terminé (V)

Merci pour votre participation

Concernant votre demande, je me pose la question pour quelle raison vous devez créer tous ces dossiers d'un bloc

Cordialement

Bonsoir Bruno,

Je ne manquerai pas de faire une petite présentation.

Je cherche à créer une arborescence de ce type afin d'y intégrer énormément de document d'une ancienne base de donnée qui sont tous mal rangé. Mes 2500 dossiers de départ correspondent à 2500 bâtiment (patrimoine d'un client) dans lesquels je dois classer plusieurs type de doc.

J'ai donc une liste de dossier avec les noms pour les créer + tous les sous-dossiers qui vont dedans et qui sont tous les mêmes.

Pour ne pas y passer trop de temps j'aimerai trouver un système automatisé qui créer les 2500 dossiers avec les nom que j'ai mis en colonne A de mon fichier puis qui créer dans chacun des dossiers les sous-dossiers en suivant systématiquement la même arborescence

Re,

Ok, je comprends

Peut-être que ceci https://forum.excel-pratique.com/excel/creer-une-arborescence-de-dossier-t68489.html
répondra à la question, à voir

A+

Re,

Oui j'ai vue ce topic mais je n'y arrive pas, je ne sais pas comment compléter le scrypt pour obtenir ce que je veux c'est à dire que le scrypt aille chercher l'arboreensce des sous-dossiers à créer sur 3 colonnes et l'intègre dans tout les dossier de la colonne A en une fois :

Je ne sais même pas quoi changer dans le code à part le mkdir et encore j'ai un message d'erreur, la ligne s'affiche en rouge

Sub CreeArboRepertoire()
Tbl = Range("A1:B" & [A65000].End(xlUp).Row).Value
n = UBound(Tbl)
niv = 1
CréeRep Tbl(1, 1), niv
End Sub

Sub CréeRep(parent, niv) ' procédure récursive
chemin = ""
RepNiv(niv) = parent
For i = 1 To niv - 1
chemin = chemin & RepNiv(i) & "\"
Next i
chemin = chemin & parent
MkDir C:\documents\XXX
For i = 1 To n
If Tbl(i, 2) = parent Then CréeRep Tbl(i, 1), niv + 1
Next i
End Sub

bonjour,

une proposition, basée sur ma compréhension que tu souhaites créer 2500 dossiers contenant chacun la structure que tu as mise dans ton premier message.

Sub aargh()
    Dim niveau(4) ' 4 niveaux + la racine (0)
    arbre = Sheets("arborescence").Range("A1:D44")
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("trace").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    Sheets.Add
    With ActiveSheet
        .Name = "trace"
        chemin = "d:\downloads\test\" '<--------------- à adapter
        nb = 10 'nombre de dossiers racine à créer <--------------- à adapter
        nr = "racine" ' nom générique du dossier racine <---------- à adapter
        For i = 1 To nb 'on crée nb dossiers racine
            niveau(0) = chemin & nr & i ' nom du dossier racine + numéro séquentiel
            ctrl = ctrl + 1
            .Cells(ctrl, 1) = "MkDir " & niveau(0)
            MkDir niveau(0) 'création du dossier racine
            ' création de l'arborescence pour le dossier racine en cours
            n = 1
            j = 1
            Do
                If arbre(j, n) <> "" Then
                    niveau(n) = niveau(n - 1) & "\" & arbre(j, n)
                    ctrl = ctrl + 1
                    .Cells(ctrl, 1) = "MkDir " & niveau(n)
                    MkDir niveau(n)
                    j = j + 1
                    d = 1
                Else
                    n = n + d
                    If n = 4 Then d = -1
                    If n = 0 Then Exit Do
                End If
            Loop Until j > 44
        Next i
    End With
End Sub

Merci pour ton aide je vais tester et te faire un retour.

En gros aujourd'hui moi j'ai tester de coder ca :

Sub créer_dossier()

'variable'

Dim SYSTEME As Worksheet
Dim lstrw As Long
Dim N_Systeme As String
Dim chemin_dossier As String
Dim colonne_B As String
Dim colonne_C1 As String
Dim colonne_C2 As String
Dim colonne_D As String
Dim chemin_sous_dossier As String
Dim chemin_sous_sous_dossier As String
Dim chemin_sous_sous_sous_dossier As String

Set SYSTEME = ActiveSheet
Set colonne_B = ActiveSheet(Rows(1), Collumns(2), Rows(6))
Set colonne_C1 = ActiveSheet("C1:C2")
Set colonne_C2 = ActiveSheet("C3:C8")
Set colonne_D = ActiveSheet("D1:D3")

lstrw = SYSTEME.Cells(Rows.Count, 1).End(xlUp).Row

For i = 2278 To lstrw

N_Systeme = SYSTEME.Cells(Row.Count, 1).End(xlUp).Row
colonne_B = colonne_B.Cells(Row.Count, .End(xlUp).Row
colonne_C1 = colonne_C1.Cells(Row.Count, 3).End(xlUp).Row
colonne_C2 = colonne_C2.Cells(Row.Count, 3).End(xlUp).Row
colonne_D = colonne_D.Cells(Row.Count, 4).End(xlUp).Row

chemin_dossier = "C:\XXXX\" & N_Systeme & "\"
chemin_sous_dossier = chemin_dossier & colonne_B & "\"
chemin_sous_sous_dossier = chemin_sous_dossier & colonne_C1 & "\"
chemin_sous_sous_dossier = chemin_sous_dossier & colonne_C2 & "\"
chemin_sous_sous_sous_dossier = chemin_sous_sous_dossier & colonne_D & "\"

If Dir(chemin_dossier, vbDirectory) <> vbNullString Then
Else

MkDir (chemin_dossier)

MkDir (chemin_sous_dossier)

End If

Next

End Sub

Edit modo : code à mettre mettre entre balises SVP avec le bouton </>

mais ca ne marche pas car j'ai du me tromper à plein d'endroit.

Dans l'idée les dossiers doivent tous se mettre dans un dossier racine exstant (type Client)

Dedans doivent e créer les 2500 dossiers (1 dossiers par bâitment) et dans chacun d'eux les sous-dossiers comme mentionné dans mon premier message.

Le problème que j'ai pour le moment c'est que soit ca me créée les dossiers racine mais pas les sous-dossiers, soit ca me créer les sous-dossier mais sans respecter l'arborescence souhaité.

Bonjour FatalitY

Pour une meilleure lisibilité et comme il est indiqué dans la charte
merci de mettre tout code donné, entre balises SVP

A+

C'est fait Bruno, désolé je suis au boulot en même temps au tel, je fais un peu vite...

J'ai un bug sur ton code h2so4,

ca me dit chemin erreur 75 : erreur d'accès chemin/fichier à la ligne suivante :

MkDir niveau(0) 'création du dossier racine

bonjour,

as-tu adapté les instructions de la macro marquées d'un <--- à adapter ?

pour éviter de perdre du temps, peux-tu mettre le fichier avec ton arborescence et la macro adaptée, ainsi qu'indiquer le chemin complet vers le répertoire dans lequel cette arborescence doit être créée ?

as-tu regardé dans la feuille trace le répertoire qu'il a essayé de créer sur base des données que tu lui as fournies ?

Bonjour,

Oui j'ai adapté mais ca ne correspond pas à mes besoins exacte, la colonne A du fichier excel c'est le nom de tous les dossier à créer, à la place ca me créer un dossier avec des numéros, ensuite les sous -dossier ne se crée pas.

J'ai adapté ton code de la manière suivante :

Sub aargh()
    Dim niveau(4) ' 4 niveaux + la racine (0)
    Dim SYSTEME As Worksheet
    Dim N_Systeme As String
    Dim lstrw As Long

    arbre = Sheets("test").Range("A1:D44")
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("trace").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    Sheets.Add
    With ActiveSheet
        .Name = "trace"
        chemin = "C:XXX\TEST INTEGRATION \"
        nb = 2249 'nombre de dossiers racine à créer <--------------- à adapter

       'identifier la feuille

    Set SYSTEME = ActiveSheet

'dernière ligne

lstrw = SYSTEME.Cells(Rows.Count, 1).End(xlUp).Row
N_Systeme = SYSTEME.Cells(Rows.Count, 1).End(xlUp).Row

'boucle sur les données

For i = 1 To lstrw

    'on crée nb dossiers racine
            niveau(0) = chemin & N_Systeme   ' nom du dossier racine + numéro séquentiel
            ctrl = ctrl + 1
            .Cells(ctrl, 1) = "MkDir " & niveau(0)
            MkDir niveau(0) 'création du dossier racine
            ' création de l'arborescence pour le dossier racine en cours
            n = 1
            j = 1
            Do
                If arbre(j, n) <> "" Then
                    niveau(n) = niveau(n - 1) & "\" & arbre(j, n)
                    ctrl = ctrl + 1
                    .Cells(ctrl, 1) = "MkDir " & niveau(n)
                    MkDir niveau(n)
                    j = j + 1
                    D = 1
                Else
                    n = n + D
                    If n = 4 Then D = -1
                    If n = 0 Then Exit Do
                End If
            Loop Until j > 44
        Next i
    End With
End Sub

Mais j'ai une erreur maintenant à se niveau là : MkDir niveau(n) ca me dit erreur accès chemin/fichier. Pour l'arborescence et le fichier adapté je ne peux pas le mettre car les noms son confidentiels (client d'état).

Mais en gros en colonne A tu as le nom des 2500 dossier à créer, en colonne B tu as les premier sous-dossier et ainsi de suite jusqu'en colonne D, bien entendu tous positionné sous forme d'arborescence donc avec des cellule vide type :

Dossier

----------------sous dossier

-------------------------------------sous sous dossier

dossier

---------------sous dossier

bonsoir,

Pour l'arborescence et le fichier adapté je ne peux pas le mettre car les noms son confidentiels (client d'état).

Qu'est-ce qui t'empêche de modifier ces noms par des noms factices ? J'essaie seulement de comprendre quelle est l'information de départ et comment elle est structurée, car manifestement je n'ai rien compris à tes explications. Donc merci de mettre un fichier avec minimum 2 clients bidons et l'arborescence souhaitée. Et la macro si tu l'as adaptée.

Voici pour ma part une nouvelle version qui se base sur une liste de répertoires à créer en feuille repertoire et une arborescence à répéter pour chaque répertoire, en feuille arborescence.

Sub aargh()
    Dim niveau(4) ' 4 niveaux + la racine (0)
    chemin = "d:\downloads\test" 'répertoire racine <--------------à adapter
    dl = Sheets("repertoire").UsedRange.Rows.Count
    client = Sheets("repertoire").Range("A1:A" & dl) ' liste des répertoires client à créer
    dl1 = Sheets("arborescence").UsedRange.Rows.Count '
    arbre = Sheets("arborescence").Range("A1:C" & dl1) ' arborescence à créer pour chaque client
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("trace").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    Set wst = Sheets.Add 'feuille trace
    With wst
        .Name = "trace" 'feuille qui contient la trace des opérations effectuées
        For i = 1 To dl
            niveau(0) = chemin & "\" & client(i, 1)
            ctrl = ctrl + 1
            .Cells(ctrl, 1) = "MkDir " & niveau(0)
            MkDir niveau(0) 'répertoire client
            n = 1
            j = 1
            Do
                If arbre(j, n) <> "" Then
                    niveau(n) = niveau(n - 1) & "\" & arbre(j, n)
                    ctrl = ctrl + 1
                    .Cells(ctrl, 1) = "MkDir " & niveau(n)
                    On Error Resume Next
                    MkDir niveau(n) 'sous répertoire selon niveau
                    If Err = 75 Then .Cells(ctrl, 2) = "existe déjà" Else If Err <> 0 Then .Cells(ctrl, 2) = Error(Err)
                    Err.Clear
                    On Error GoTo 0
                    j = j + 1
                    d = 1
                Else
                    n = n + d
                    If n = 3 Then d = -1
                    If n = 0 Then Exit Do
                End If
            Loop Until j > dl1
        Next i
        .Range("A:B").EntireColumn.AutoFit
    End With
End Sub

Bonjour,

Toujours la même erreur ici :

Le répertoire erreur 75 chemin/fichier.

Ci-joint un exemple des deux feuille excel avec le repétoire et l'arboresence

bonsoir,

la macro donne une erreur quand elle essaie de créer un répertoire qui existe déjà, je n'avais pas prévu que tu demanderais de créer plusieurs fois les mêmes répertoires, car cela ne fait pas de sens. Si tu veux des dossiers différents, il faut leur donner des noms différents.

donc voici une version qui gère ces cas de figure, pour le cas où.

Sub aargh()
    Dim niveau(4) ' 4 niveaux + la racine (0)
    chemin = "d:\downloads\test" 'répertoire racine <--------------à adapter
    dl = Sheets("repertoire").UsedRange.Rows.Count
    client = Sheets("repertoire").Range("A1:A" & dl) ' liste des répertoires client à créer
    dl1 = Sheets("arborescence").UsedRange.Rows.Count '
    arbre = Sheets("arborescence").Range("A1:D" & dl1) ' arborescence à créer pour chaque client
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("trace").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    Set wst = Sheets.Add 'feuille trace
    With wst
        .Name = "trace" 'feuille qui contient la trace des opérations effectuées
        For i = 1 To dl
            niveau(0) = chemin & "\" & client(i, 1)
            ctrl = ctrl + 1
            .Cells(ctrl, 1) = "MkDir " & niveau(0)
            On Error Resume Next
            MkDir niveau(0) 'répertoire client
            If Err = 75 Then .Cells(ctrl, 2) = "existe déjà" Else If Err <> 0 Then .Cells(ctrl, 2) = Error(Err)
            Err.Clear
            On Error GoTo 0
            n = 1
            j = 1
            Do
                If arbre(j, n) <> "" Then
                    niveau(n) = niveau(n - 1) & "\" & arbre(j, n)
                    ctrl = ctrl + 1
                    .Cells(ctrl, 1) = "MkDir " & niveau(n)
                    On Error Resume Next
                    MkDir niveau(n) 'sous répertoire selon niveau
                    If Err = 75 Then .Cells(ctrl, 2) = "existe déjà" Else If Err <> 0 Then .Cells(ctrl, 2) = Error(Err)
                    Err.Clear
                    On Error GoTo 0
                    j = j + 1
                    d = 1
                Else
                    n = n + d
                    If n = 4 Then d = -1
                    If n = 0 Then Exit Do
                End If
            Loop Until j > dl1
        Next i
        .Range("A:B").EntireColumn.AutoFit
    End With
End Sub

Si à nouveau cette solution ne te convient pas, mets un fichier avec les données de départ que tu penses mettre à disposition pour créer l'arborescence et un exemple (pour 2 "bâtiments") de l'arborescence complète telle que tu la voudrais. Sache qu'il n'est pas possible de créer 2 chemins complets identiques.

C'est bon ca marche super bien, merci beaucoup pour ton aide tu viens de me faire gagner de nombreuses heures de boulot pour rien.