Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Membre à l'essai
    Homme Profil pro
    Ingénieur Calcul
    Inscrit en
    mars 2016
    Messages
    32
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Pas de Calais (Nord Pas de Calais)

    Informations professionnelles :
    Activité : Ingénieur Calcul

    Informations forums :
    Inscription : mars 2016
    Messages : 32
    Points : 17
    Points
    17

    Par défaut Création de dossiers et de sous dossiers

    Bonsoir,

    Je developpe une macro me permettant de ranger des dossiers et des sous dossiers à partir d'un fichier excel avec deux colonnes : la première A ou il y'a le niveau du rangement et la seconde B ou il y' a les noms des dossiers à ranger, par exemple j'aimerai créer un dossier source PRJ-2018-00000748 car il a un attribut 1 de la colonne A et à l'intérieur de ce dossier il y' aura un sous dossier XJF-XJI Sq 52 car il a 2 comme attribut et à l'intérieur du sous dossier XJF-XJI Sq 52 il y ' aura le sous dossier Lot 1 car il a 3 comme attribut dans la colonne A et ainsi de suite jusqu'au rangement de tout les dossiers selon leur level. Merci de m'aider à compléter mon code si vous avez des idéesNom : tab.PNG
Affichages : 45
Taille : 4,0 Ko

    Cordialement;

  2. #2
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    juillet 2009
    Messages
    2 175
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 63
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : juillet 2009
    Messages : 2 175
    Points : 5 081
    Points
    5 081

    Par défaut

    Bonjour;

    Les nombres(ou numéros) de 1 à 4 correspondent au niveau de chaque sous-dossier par rapport aux autres et non à des attributs, comme tu l'appelles.
    Les sous-dossiers de niveau 4 où seront-ils placés ? Est-ce dans Lot1, Lot2, Lot3 ou RJI ?
    Je pose cette question car la tienne n'est pas tout à fait claire !
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Balises CODE indispensables. Regardez ICI
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA)
    Vous pouvez consulter mes contributions
    Consultez les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

  3. #3
    Membre à l'essai
    Homme Profil pro
    Ingénieur Calcul
    Inscrit en
    mars 2016
    Messages
    32
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Pas de Calais (Nord Pas de Calais)

    Informations professionnelles :
    Activité : Ingénieur Calcul

    Informations forums :
    Inscription : mars 2016
    Messages : 32
    Points : 17
    Points
    17

    Par défaut

    Bonjour,

    Merci pour votre retour, oui effectivement les sous dossiers de niveaux 4 seront placés dans tout les sous dossiers de niveau 3 jusqu'a remonter au dossier parent de niveau 1

  4. #4
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    juillet 2009
    Messages
    2 175
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 63
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : juillet 2009
    Messages : 2 175
    Points : 5 081
    Points
    5 081

    Par défaut

    Une petite esquisse(il y a certes mieux) est ce
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    Option Explicit 
     
    Dim fso, oFold, ArrFolders, I, BeginPath, FD, tmp
     ArrFolders = Array("PRJ-2018-00000748", "XJF-XJI Sq 52", "Lot 1", "Lot 2", "Lot 3", "RJI", "CF", "CO", "VPC")
    BeginPath = "C:\Temp\" ' Mettre ici le chemin correct
    Set fso = CreateObject("Scripting.FileSystemObject") 
    tmp = BeginPath & ArrFolders(0)
    If Not fso.FolderExists(tmp) Then 
        Set oFold = fso.CreateFolder(tmp) 
    Else 
        ' (1) : Sans cette instruction, si le dossier existe, il y a erreur car il n'y aurait pas d'objet oFold
        Set oFold = fso.GetFolder(tmp) 
    End If
    ' oFold.Path correspond maintenant à C:\Temp\PRJ-2018-00000748\XJF-XJI Sq 52
    tmp = AddDirSep(oFold.Path) & ArrFolders(1)
    If Not fso.FolderExists(tmp) Then
        Set oFold = fso.CreateFolder(tmp)
    Else 
        ' (2) : Même remarque que (1)
        Set oFold = fso.GetFolder(tmp) 
    End If
    For I = 2 to 5
        tmp = AddDirSep(oFold.Path) & ArrFolders(I)
        If Not fso.FolderExists(tmp) Then fso.CreateFolder(tmp)
    Next
     
     
    For Each FD IN oFold.SubFolders
       For I = 6 To 8
           tmp = AddDirSep(FD.Path) & ArrFolders(I)
           If Not fso.FolderExists(tmp) Then  fso.CreateFolder(tmp)
       Next 'I
    Next ' FD
    '=======================================
     Function AddDirSep(strFolder)
       ' On s'assure que le chemin se termine par le caractère \
       If Right(strFolder, 1 ) <> "\" Then strFolder = strFolder & "\"
       AddDirSep = strFolder 
    End Function
    A remarquer que je n'ai pas traité le cas où les données seraient stockées dans un fichier excel.
    A toi d'adapter selon ton besoin.
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Balises CODE indispensables. Regardez ICI
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA)
    Vous pouvez consulter mes contributions
    Consultez les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

  5. #5
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    juillet 2009
    Messages
    2 175
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 63
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : juillet 2009
    Messages : 2 175
    Points : 5 081
    Points
    5 081

    Par défaut

    Voici un code qui recherche les données(noms des sous-dossiers) dans le fichier excel puis crée lesdits dossiers(ou sous-dossiers) :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    Option Explicit  
    Dim fso, oFold, arrFolders, I, BeginPath, FD, tmp
     ' Tableau ordonné suivant le niveau de chaque sous-dossier :
     ' arrFolders = Array("PRJ-2018-00000748", "XJF-XJI Sq 52", "Lot 1", "Lot 2", "Lot 3", "RJI", "CF", "CO", "VPC")
     'Indices des éléments :  0            ,       1        ,     2   ,   3   ,   4    ,   5  ,   6  ,  7 ,   8
     'Niveau                  1                    2              3       3       3        3      4     4     4
     ' Le tableau est rempli par la Sub  FillTable à partir du fichier excel.
    FillTable
    BeginPath = "C:\Temp\" ' Mettre ici le chemin correct
    Set fso = CreateObject("Scripting.FileSystemObject") 
     
     
    tmp = BeginPath & arrFolders(0)
    If Not fso.FolderExists(tmp) Then 
        Set oFold = fso.CreateFolder(tmp) 
    Else 
        ' (1) : Sans cette instruction, si le dossier existe, il y a erreur car il n'y aurait pas d'objet oFold
        Set oFold = fso.GetFolder(tmp) 
    End If
    ' oFold.Path correspond maintenant à C:\Temp\PRJ-2018-00000748\XJF-XJI Sq 52
     
     
    tmp = AddDirSep(oFold.Path) & arrFolders(1)
    If Not fso.FolderExists(tmp) Then
        Set oFold = fso.CreateFolder(tmp)
    Else 
        ' (2) : Même remarque que (1)
        Set oFold = fso.GetFolder(tmp) 
    End If
    ' Création des sous-dossiers Lot 1, Lot 2, Lot 3 et RJI  dans le sous-dossier XJF-XJI Sq 52
    For I = 2 to 5
        tmp = AddDirSep(oFold.Path) & arrFolders(I)
        If Not fso.FolderExists(tmp) Then fso.CreateFolder(tmp)
    Next
     
     'Création des sous-dossiers CF, CO et VPC dans chacun des 4 sous-dossiers précédents
    For Each FD IN oFold.SubFolders
       For I = 6 To 8
           tmp = AddDirSep(FD.Path) & arrFolders(I)
           If Not fso.FolderExists(tmp) Then  fso.CreateFolder(tmp)
       Next 'I
    Next ' FD
    '=======================================
     Function AddDirSep(strFolder)
       ' On s'assure que le chemin se termine par le caractère \
       If Right(strFolder, 1 ) <> "\" Then strFolder = strFolder & "\"
       AddDirSep = strFolder 
    End Function
    '=======================================
    Sub FillTable()
        Const xlGuess = 0, ForWriting = 2
        Dim  Cnt, XL, WB, Sht, I
     
        Set XL = CreateObject("Excel.Application") 
        XL.Visible = True
        XL.DisplayAlerts = False 
        Set WB = XL.Workbooks.Open("C:\Temp\SourceFile.xls") ' Mettre le chemin correct du fichier
        Set Sht = WB.Worksheets("Feuil1")
        'Syntaxe pour le tri :
        'Expression.Sort(Key1, Order1, Key2, Type, Order2, Key3, Order3, Header, OrderCustom, MatchCase, Orientation, SortMethod, DataOption1, DataOption2, DataOption3)
        Sht.Range("A1").Sort Sht.Columns("A"), , , , , , , xlGuess ' header=0(valeur:xlGuess) : ne prend pas en compte la ligne d'en-tête.
          Cnt = Sht.UsedRange.Rows.Count
        ReDim arrFolders(0)
        For I = 2 To  Cnt
         With Sht  
           ReDim Preserve arrFolders(I-2)
           arrFolders(I-2) = .Cells(I, 2)
         End With 
        Next 
     
     
       'Enregistrement ou non ? Même si on n'enregistre pas, 
       'les données sont triées et passées au tableau arrFolders dans l'ordre voulu
        If MsgBox("Enregistrer les modification ?",vbYesNo+vbExclamation,"Enregistrer " & WB.Name) = vbYes Then WB.Save
        'Fermetuure d'excel et nettoyage      
        XL.Quit
        Set XL = Nothing
    End Sub
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Balises CODE indispensables. Regardez ICI
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA)
    Vous pouvez consulter mes contributions
    Consultez les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

Discussions similaires

  1. Réponses: 1
    Dernier message: 11/03/2013, 08h54
  2. Création de dossiers dans les sous-dossiers
    Par djaih dans le forum Shell et commandes GNU
    Réponses: 4
    Dernier message: 26/05/2011, 14h29
  3. [Leopard] Automatiser création de dossiers/sous dossiers
    Par Ambuletz dans le forum Apple
    Réponses: 6
    Dernier message: 03/03/2010, 21h07
  4. création de dossier impossible sous windows XP
    Par bringer dans le forum Général Python
    Réponses: 9
    Dernier message: 26/11/2009, 23h12
  5. Réponses: 18
    Dernier message: 18/02/2008, 10h23

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo