Microsoft 365 Création de sous dossier dans dossier aléatoire

jamespatagueul

XLDnaute Occasionnel
Bonjour à tous,

Je cherche à créer en VBA des sous sous dossiers ( NOM Prénom) dans différents dossiers.
J'ai déjà créer l'arborescence, je souhaite donc maintenant pouvoir créer le reste selon un onglet.

structure :
colonne A : NOM
colonne B : Prénom
colonne C : Etablissement (5 différents)
départ de la liste de A3 à A xxx (évolutif)

arborescence : thisworkbook\annee\sites\

Comment en VBA pouvoir créer les dossiers NOM Prénom dans chaque sites qui convient.

Merci à tous
 

patricktoulon

XLDnaute Barbatruc
Bonjour
c'est assez simple en fait
VB:
Option Explicit
Sub createfolder()
    Dim Fparent$, i&, q&, chemin$, t, D$ 'variable
    
    Fparent = ThisWorkbook.Path & "\annee\sites" 'chemin de base
    
    With Feuil1 'object feuille a adapter
        
        For i = 3 To Feuil1.Cells(Rows.Count, 1).End(xlUp).Row
            
            'chemin = la base & "\" & .la colonne 3 & "\" & lacolonne 1 et 2
            
             chemin = Fparent & "\" & .Cells(i, 3) & "\" & .Cells(i, 1) & " " & .Cells(i, 2) 'concat
            
            t = Split(chemin, "\") 'recoupe
            
            D = t(0) 'd=le premier dossier dans la base
            
            For q = 1 To UBound(t) 'boucle a partir du 2d segment du chemin
                
                D = D & "\" & t(q) 'concat progressif  avec separateur"\"
                
                If Dir(D, vbDirectory) = "" Then MkDir (D) 'test d'existance et creation si il le faut
            
            Next
        
        Next
    
    End With

End Sub
je joins un fichier exemple
 

Pièces jointes

  • create folder and sub folder by table.xlsm
    14.1 KB · Affichages: 6

jamespatagueul

XLDnaute Occasionnel
Bonjour
c'est assez simple en fait
VB:
Option Explicit
Sub createfolder()
    Dim Fparent$, i&, q&, chemin$, t, D$ 'variable
   
    Fparent = ThisWorkbook.Path & "\annee\sites" 'chemin de base
   
    With Feuil1 'object feuille a adapter
       
        For i = 3 To Feuil1.Cells(Rows.Count, 1).End(xlUp).Row
           
            'chemin = la base & "\" & .la colonne 3 & "\" & lacolonne 1 et 2
           
             chemin = Fparent & "\" & .Cells(i, 3) & "\" & .Cells(i, 1) & " " & .Cells(i, 2) 'concat
           
            t = Split(chemin, "\") 'recoupe
           
            D = t(0) 'd=le premier dossier dans la base
           
            For q = 1 To UBound(t) 'boucle a partir du 2d segment du chemin
               
                D = D & "\" & t(q) 'concat progressif  avec separateur"\"
               
                If Dir(D, vbDirectory) = "" Then MkDir (D) 'test d'existance et creation si il le faut
           
            Next
       
        Next
   
    End With

End Sub
je joins un fichier exemple
Bonsoir,
et merci de ton aide.
J'ai réadapter à mon contexte, et nikel.
 

jamespatagueul

XLDnaute Occasionnel
Bonjour à tous,
je déterre ce post, car l'arborescence a changée, et je n'arrive pas a adapter.

nouvelle arborescence : thisworkbook\annee\sites\etablissement 1 ou 2 ou 3 ...\essai\equipe & "etablissement 1 ou 2 ou 3 ..."\

je souhaiterai que dans le dossier final soit creer les dossiers nominatifs, comme le fichier exemple fournir par patricktoulon, qui fonctionne a merveille, mais avec la nouvelle arborescence.

Merci de votre aide
 

Discussions similaires

Réponses
11
Affichages
251

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 337
Messages
2 087 391
Membres
103 536
dernier inscrit
komivi