XL 2013 Création de dossier , sous dossiers......

Jean-Philippe B

XLDnaute Nouveau
Bonjour

Dans le cadre de mon Travail, j'ai besoin de crée une arborescence avec de nombreux dossiers et sous dossiers

Dossier 1-------dossier1.1----------dossier 1.1.1
-------dossier1.2----------dossier 1.1.2
Dossier 2-------dossier2.1----------dossier 2.1.1
-------dossier2.2----------dossier 2.1.2
La génération du dossier 1,2....... dans la colonne A
La génération du sous dossier 1.1,1.2 dans la colonne B etc......

1602749357377.png

Pouvez-vous m'aider sur ce sujet, je ne connais absolument pas le VBA

Merci par avance
 

Fichiers joints

sousou

XLDnaute Barbatruc
Bonjour,
Voici un exemple qui doit peut-être remanié en fonction de tes besoins précis.
Ici tu selectionnes les dossiers pères colonne 1
chacun des dossiers sélectionnés ainsi que les sous dossiers seront créés dans le répertoire contenant ce fichier excel
 

Fichiers joints

Jacky67

XLDnaute Accro
Bonjour

Dans le cadre de mon Travail, j'ai besoin de crée une arborescence avec de nombreux dossiers et sous dossiers

Dossier 1-------dossier1.1----------dossier 1.1.1
-------dossier1.2----------dossier 1.1.2
Dossier 2-------dossier2.1----------dossier 2.1.1
-------dossier2.2----------dossier 2.1.2
La génération du dossier 1,2....... dans la colonne A
La génération du sous dossier 1.1,1.2 dans la colonne B etc......

Voir la pièce jointe 1081579

Pouvez-vous m'aider sur ce sujet, je ne connais absolument pas le VBA

Merci par avance
Bonjour à tous,
Avec ce que j'ai compris et en adaptant le chemin de départ.
Une proposition en PJ avec ce code
VB:
Sub dossiersJJ()
    Dim i&, J&, K&, Lecteur$
    On Error Resume Next
    Lecteur = "D:\"     '  **** adapter le chemin de départ commun ****
    For i = 1 To 5
        MkDir Lecteur & Cells(i, 1)
        For J = 2 To 4
            MkDir Lecteur & Cells(i, 1) & "\" & Cells(i, J)
            For K = 1 To 9
                MkDir Lecteur & Cells(i, 1) & "\" & Cells(i, J) & "\" & Cells(K, J)
            Next
        Next
    Next
End Sub
 

Fichiers joints

kiki29

XLDnaute Barbatruc
Salut, à adapter
VB:
Sub CreationDossier()
Dim sDossier As String
Dim sChaine As String
    sDossier = "C:\Essai1\Essai2\Essai3\Essai4\Essai5"
    sChaine = Environ("comspec") & " /c mkdir " & sDossier
    Shell sChaine, 0
End Sub
Sinon si Office en 32 bits :
Code:
Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                             (ByVal hwnd As Long, _
                                              ByVal pszPath As String, _
                                              ByVal lngsec As Long) As Long

Option Explicit

Private Function CreationDossier_01(sDossier As String) As Long
Dim Rep As Long
    Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
End Function
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas