Création de dossier et sous dossier niveau 2 et 3

Version imprimable

04/01/2017, 18h37
proumeau

1 pièce(s) jointe(s)

Création de dossier et sous dossier niveau 2 et 3

Bonsoir,

Depuis quelques jours je travail sur un fichier excel afin de le programmer pour créer des dossiers ainsi que des sous dossier et d'autres dossiers à l'intérieur de ces sous dossier.

Problème, je n'arrive pas à faire cette dernière partie. (création de dossier à l'intérieur des sous-dossier)

Tout est clair dans l'Excel, la deuxième page représente dans la première colonne (le 1er dossier), dans la deuxième colonne (le dossier dans le dossier 1) et les dernières colonnes représentent les sous-dossier qui doivent aller dans le 2ème dossier qui se situe en face.

La première page elle est consacré au nom du dossier principale et à la réalisation de la macro

Merci d'avance pour votre aide.

Cordialement.

Pièce jointe 232189

Citation:

Envoyé par proumeau

Bonjour,

Le fichier joint contient ce code :

Code:

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
 
Option Explicit
 
Sub CreerRepertoires()   ' répertoires à traiter
 
Dim ShCreation As Worksheet
Dim Repertoire As String
Dim NomDuDossier As String, NomDuSousDossier As String, DossierEnCours As String
Dim LigneEncours As Long, LigneTitreCreation As Long
Dim SousDossiersExistants As String, SousDossiersCrees As String
 
    Set ShCreation = Sheets("Noms qui seront créés")
    Repertoire = ActiveWorkbook.Path
    ChDir Repertoire
 
    With ShCreation
 
         LigneTitreCreation = 1
         NomDuDossier = .Cells(LigneTitreCreation + 1, 1)
         SousDossiersExistants = "Les dossiers ou sous-dossiers existants sont les suivants : " & Chr(10) & Chr(10)
         SousDossiersCrees = "Les dossiers ou sous-dossiers créés sont les suivants : " & Chr(10) & Chr(10)
 
 
        ' Vérification existence et création du dossier
        '----------------------------------------------
        DossierEnCours = Repertoire & "\" & NomDuDossier
        If RepertoireExiste(DossierEnCours) = False Then
           MkDir DossierEnCours
           SousDossiersCrees = SousDossiersCrees & NomDuDossier & Chr(10)
        Else
           SousDossiersExistants = SousDossiersExistants & NomDuDossier & Chr(10)
        End If
 
        For LigneEncours = LigneTitreCreation + 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
            NomDuSousDossier = .Cells(LigneEncours, 2)
            DossierEnCours = Repertoire & "\" & NomDuDossier & "\" & .Cells(LigneEncours, 2)
            If RepertoireExiste(DossierEnCours) = False Then
                MkDir DossierEnCours
                SousDossiersCrees = SousDossiersCrees & NomDuDossier & "\" & NomDuSousDossier & Chr(10)
            Else
                SousDossiersExistants = SousDossiersExistants & NomDuDossier & "\" & NomDuSousDossier & Chr(10)
            End If
        Next LigneEncours
 
        MsgBox SousDossiersCrees & Chr(10) & Chr(10) & SousDossiersExistants
 
    End With
    Set ShCreation = Nothing
 
 
End Sub
 
 
Function RepertoireExiste(ByVal RepertoireNom As String) As Boolean
         RepertoireExiste = Dir(RepertoireNom, vbDirectory) <> ""
End Function

Ce qu'il faut retenir :

Notez l'emplacement du code qui n'est plus dans un module d'onglet mais dans un module standard.
Donnez un libellé explicite à vos variables pour faciliter la maintenance du code.
Indiquez le type de données attendues à vos fonctions.
Evitez les caractères signés é (ou autres) dans le nom de vos procédures ou variables.

Pièce jointe 232298

Cordialement.

05/01/2017, 07h25
unparia

Bonjour (et un salut à Eric KERGRESSE)
N'ayant pas ouvert le classeur joint (ce que je ne fais jamais) j'en ignore le code.
Mon intervention n'est là que pour rappeler les vertus de la fonction SHCreateDirectoryEx de la librairie User32 de l'Api de windows.
Sa vocation est de ne créer, dans quelque arborescence spécifiée que ce soit, que ce qui n'existe pas encore, à quelque niveau que ce soit de l'arborescence.
Elle s'utilise aini :
1) déclaration dans la partie "générale" (avant toute procédure) :

Code:

Private Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" (ByVal hwnd As Long, ByVal pszPath As String, ByVal psa As Any) As Long

2) code d'appel depuis une procédure (exemple)

Code:

SHCreateDirectoryEx 0, "d:\monoutil\xxx\yyy", ByVal 0&

Très efficace.
05/01/2017, 07h41
proumeau

Bonjour et merci à Eric KERGRESSE.

Le message apparait bien en me disant que le dossier à été créé mais je n'arrive pas a comprendre ou est-ce qu'il s'enregistre...

Merci d'avance, désolé je suis novice en programmation ...

Cordialement.
05/01/2017, 07h51
proumeau

Re bonjour,

Je viens de voir où est ce qu'il s'enregistre. J'aimerai changer l'endroit est-ce possible ?

En revanche, les sous-dossier "Fichier compilés et Fichier sources" et "DAF, Diffusion des documents, Docs suivi des travaux, Fiches d'observation, Notes de calculs, Plan, Procédures et QSE" ne sont pas créés. Les deux sous-dossier "Fichier compilés et Fichier sources" doivent aller dans le dossier "DOE" et les autres dans le fichier "Etudes d'exécution".

Merci d'avance ...

Pierre ROUMEAU
05/01/2017, 08h16
Invité

http://www.developpez.net/forums/d14...r/#post8039740
05/01/2017, 08h39
Invité

Citation:

Envoyé par proumeau

Je viens de voir où est ce qu'il s'enregistre. J'aimerai changer l'endroit est-ce possible ?
En revanche, les sous-dossier "Fichier compilés et Fichier sources" et "DAF, Diffusion des documents, Docs suivi des travaux, Fiches d'observation, Notes de calculs, Plan, Procédures et QSE" ne sont pas créés. Les deux sous-dossier "Fichier compilés et Fichier sources" doivent aller dans le dossier "DOE" et les autres dans le fichier "Etudes d'exécution".

Le plus simple serait d'ajouter autant de lignes que nécessaire comme ci-dessous :

Pièce jointe 232299

Cordialement.
05/01/2017, 09h07
proumeau

Merci beaucoup Eric KERGRESSE.

Mon seul problème maintenant et de choisir la destination de sauvegarde.

En espérant que tu es la solution. merci beaucoup encore une fois.

Cordialement.

Pierre ROUMEAU

Citation:

Envoyé par proumeau

Mon seul problème maintenant et de choisir la destination de sauvegarde.

Effectivement :

Code:

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
 
Sub CreerRepertoiresV2()   ' répertoires à traiter
 
Dim ShCreation As Worksheet
Dim Repertoire As String
Dim NomDuDossier As String, NomDuSousDossier As String, DossierEnCours As String
Dim LigneEncours As Long, LigneTitreCreation As Long
Dim SousDossiersExistants As String, SousDossiersCrees As String
 
 
     Repertoire = ""
     With Application.FileDialog(msoFileDialogFolderPicker)
          .InitialFileName = ActiveWorkbook.Path
          .Show
          If .SelectedItems.Count > 0 Then
             Repertoire = .SelectedItems(1)
             ChDir Repertoire
          End If
     End With
 
   ' MsgBox Repertoire
 
    If Repertoire = "" Then
       MsgBox "Aucun répertoire sélectionné, fin de programme !", vbCritical
       Exit Sub
    End If
 
    Set ShCreation = Sheets("Noms qui seront créés")
 
    With ShCreation
 
         LigneTitreCreation = 1
         NomDuDossier = .Cells(LigneTitreCreation + 1, 1)
         SousDossiersExistants = "Les dossiers ou sous-dossiers existants sont les suivants " & Chr(10) & Chr(10)
         SousDossiersCrees = "Les dossiers ou sous-dossiers créés sont les suivants " & Chr(10) & Chr(10)
 
 
        ' Vérification existence et création du dossier
        '----------------------------------------------
        DossierEnCours = Repertoire & "\" & NomDuDossier
        If RepertoireExiste(DossierEnCours) = False Then
           MkDir DossierEnCours
           SousDossiersCrees = SousDossiersCrees & NomDuDossier & Chr(10)
        Else
           SousDossiersExistants = SousDossiersExistants & NomDuDossier & Chr(10)
        End If
 
        For LigneEncours = LigneTitreCreation + 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
            NomDuSousDossier = .Cells(LigneEncours, 2)
            DossierEnCours = Repertoire & "\" & NomDuDossier & "\" & .Cells(LigneEncours, 2)
            If RepertoireExiste(DossierEnCours) = False Then
                MkDir DossierEnCours
                SousDossiersCrees = SousDossiersCrees & NomDuDossier & "\" & NomDuSousDossier & Chr(10)
            Else
                SousDossiersExistants = SousDossiersExistants & NomDuDossier & "\" & NomDuSousDossier & Chr(10)
            End If
        Next LigneEncours
 
        MsgBox SousDossiersCrees & Chr(10) & Chr(10) & SousDossiersExistants
 
    End With
    Set ShCreation = Nothing
 
End Sub

05/01/2017, 09h51
proumeau

Super !!!!

Merci beaucoup et a bientôt !!!
05/01/2017, 10h17
halaster08

Citation:

Envoyé par unparia

Bonjour (et un salut à Eric KERGRESSE)
N'ayant pas ouvert le classeur joint (ce que je ne fais jamais) j'en ignore le code.
Mon intervention n'est là que pour rappeler les vertus de la fonction SHCreateDirectoryEx de la librairie User32 de l'Api de windows.
Sa vocation est de ne créer, dans quelque arborescence spécifiée que ce soit, que ce qui n'existe pas encore, à quelque niveau que ce soit de l'arborescence.
Elle s'utilise aini :
1) déclaration dans la partie "générale" (avant toute procédure) :

Code:

Private Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" (ByVal hwnd As Long, ByVal pszPath As String, ByVal psa As Any) As Long

2) code d'appel depuis une procédure (exemple)

Code:

SHCreateDirectoryEx 0, "d:\monoutil\xxx\yyy", ByVal 0&

Très efficace.

Bonjour,
Cette fonction m'intéresse beaucoup, mais je n'en comprends pas les paramètres (a part le chemin)
L'aide me donne ceci:

Citation:

hwnd [in, optional]
Type: HWND

A handle to a parent window. This parameter can be set to NULL if no user interface will be displayed.
pszPath [in]
Type: LPCTSTR

A pointer to a null-terminated string specifying the fully qualified path of the directory. This string is of maximum length of 248 characters, including the terminating null character.
psa [in, optional]
Type: const SECURITY_ATTRIBUTES*

A pointer to a SECURITY_ATTRIBUTES structure with the directory's security attribute. Set this parameter to NULL if no security attributes need to be set.

Mais il n'y a aucun exemple, où puis-je trouver des infos sur les valeurs possibles (et leurs effet) que peuvent prendre hwnd et psa?

Merci d'avance.
05/01/2017, 10h48
unparia

Bonjour halaster08

Le paramètre hwnd de cette fonction n'est pas vraiment utile pour créer une arborescence dans les conditions de la fonction (qui ne crée que les "noeuds" absents)
Regarde par quoi je l'ai remplacé dans ma ligne de code : par 0, ce qui veut dire que j'ai associé la fonction au handle du bureau (desktop).
Depuis VBA/Excel, l'utilisation d'un autre handle conduirait d'ailleurs de surcroît à d'autres alourdissements (extraction du handle de la fenêtre à laquelle ont veut associer la fonction). Si tu tiens à utiliser ce paramètre, tu peux fort bien choisir, par exemple, Application.hwnd, puisque tant- l'objet Application est nativement doté de la propriété hwnd.
Mais si tu veux l'associer à d'autres fenêtres (userform, par exemple) il te faudra d'abord extraire, pour l'utiliser, le handle de la fenêtre (et donc alourdir)
Si maintenant, ta question est : "alors dans quel cas une telle association spécifique est-elle utile ?". La réponse est : si accompagnée d'une interception des messages Windows reçus par la fenêtre en cause (celle dont on a spécifié le handle). Or, à moins que tu n'aies à la fois de grandes connaissances relatives à ce genre d'interceptions, d'une part, et une réelle utilité de la chose, cela ne te servira à rien.
Je ne sais pas si j'ai là été assez clair. Si tel n'est pas le cas, dis-le moi et j'essaierai alors de m'exprimer avec d'autres mots.
Amitiés
05/01/2017, 11h15
unparia

Ah !
Je viens de m'apercevoir que j'ai "zappé" une partie de ton message/question ..

voici quelques constantes :
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_COMPRESSED = &H800
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H0
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Les "choses" ne sont toutefois pas aussi simples que de les utiliser toujours directement dans la fonction.
Il faudra en plus déclarer une structure (une variable personnalisée - private type ... end type) que l'on baptise généralement SECURITY_ATTRIBUTES (mais on peut l'appeler autrement) dont il faut spécifier chaque membre en lui attribuant une valeur présente dans un descripteur.
tu trouveras ici
https://msdn.microsoft.com/en-gb/lib...(v=vs.85).aspx
ce qu'est ce genre de descripteur.
Ce "volet"-là n'est pas simple et tu pourras trouver bien plus facile, si tu en as le besoin, d'appliquer tout simplement l'instruction native SetAttr de VBA à chacun des "chemins" ou "sous-chemins" créés. D'autant que ce sera ainsi moins rigide et que cela te permettra en outre de donner tel attribut à tel "sous-chemin" et tel autre attribut à tel autre "sous-chemin"

Je pense avoir maintenant été complet.
Amitiés
05/01/2017, 11h20
halaster08

Merci de ta réponse, tu as été clair et complet.