Discussion :

[Sami_Xite]

Bonjour,

J'ai besoin de créer une macro qui me permettrait de créer un dossier sur un partage réseau sur la base du contenu d'une cellule ainsi que des sous dossiers qui eux auraient toujours le même nom.
Exemple :
Contenu de la cellule : 2021-0001 => Création d'un dossier sur le partage \\srv1\myshare du dossier 2021-0001 contenant les sous-dossiers A,B,et C
Contenu de la cellule : 2021-0002 => Création d'un dossier sur le partage \\srv1\myshare du dossier 2021-0002 contenant les sous-dossiers A,B,et C ( toujours les mêmes sous dossiers )
etc ...

Merci d'avance pour votre aide

[Zekraoui_Jakani]

Voici un exemple:

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
 
Sub MakeFolder()
'Voici une procédure et 2 fonctions.
'La procédure crée le répertoire via 2 fonctions qui vérifient l'existence ou créent ce répertoire.
 
'Il faut activer la librairie "Microsoft Scripting Runtime" pour que ça marche
 
    Dim Parent As String, SousDossier As String, Chemin As String
 
    Parent = ThisWorkbook.Sheets("Sheet3").Range("A5") ' si le dossier parent se trouve en A5
    SousDossier = ThisWorkbook.Sheets("Sheet3").Range("B5") ' si le sous-dossier se trouve en B5
    Chemin = ThisWorkbook.path & "\"    'créer le dossier sous le même répertoire que le fichier ouvert
 
    MsgBox Chemin & Parent & "\" & SousDossier
    If Not FolderExists(Chemin & Parent) Then
        'créer le parent s'il n'existe pas
        FolderCreate Chemin & Parent & "\"
    Else
        'créer le sous-dossier s'il n'existe pas
        If Not FolderExists(Chemin & Parent & "\" & SousDossier) Then
            FolderCreate Chemin & Parent & "\" & SousDossier
        End If
    End If
 
End Sub
 
Function FolderCreate(ByVal path As String) As Boolean
 
FolderCreate = True
Dim fso As New FileSystemObject
 
If fso.FolderExists(path) Then
    Exit Function
Else
    On Error GoTo Avertissament
    fso.CreateFolder path ' source d'erreur si le nom ne convient pas !!
    Exit Function
End If
 
Avertissament:
    MsgBox "A folder could not be created for the following path: " & path & ". Check the path name and try again."
    FolderCreate = False
    Exit Function
 
End Function
 
Function FolderExists(ByVal path As String) As Boolean
 
    FolderExists = False
    Dim fso As New FileSystemObject
 
    If fso.FolderExists(path) Then FolderExists = True
 
End Function

[Sami_Xite]

Bonjour,

Merci pour ton aide
Quelques précisions :

Le dossier doit être créé sur un partage réseau du type \\monseveur\monpartage$
Les sous dossiers doivent tous avoir le même nom, leurs noms ne reposent pas sur la valeur d'une ou plusieurs cellules
Ex :
\\monseveur\monpartage$\Dossier1\sous_dossier1
\\monseveur\monpartage$\Dossier1\sous_dossier2

\\monseveur\monpartage$\Dossier2\sous_dossier1
\\monseveur\monpartage$\Dossier2\sous_dossier2

Merci encore

[Pierre Fauconnier]

Salut

Un tableau structuré avec les dossiers t_Dossiers, un avec les sous-dossiers t_Sousdossiers et une plage nommée avec le chemin d'accès Chemin, et en testant l'éventuelle existence des dossiers ou sous-dossiers, j'utiliserais le code suivant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Test()
  Dim f As Range
  Dim sf As Range
  Dim Path As String
 
  Path = Range("Chemin").Value
  For Each f In Range("t_Dossiers")
    If Dir(Path & "\" & f.Value, vbDirectory) = "" Then MkDir Path & "\" & f.Value
    For Each sf In Range("t_sousdossiers")
      If Dir(Path & "\" & f.Value & "\" & sf.Value, vbDirectory) = "" Then MkDir Path & "\" & f & "\" & sf.Value
    Next
  Next
End Sub

[Sami_Xite]

Bonjour,

C'est juste parfait, merci beaucoup !!!
J'abuse un peu avec une dernière question
Est ce qu'il est possible de définir la variable "Path" avec la variable d'environnement %USERPROFILE% ?
Ex : Path = %USERPROFILE%\Myshare\

Merci encore

[...]

[Pierre Fauconnier]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Path = Environ("userprofile") & "\myshare"

[Pierre Fauconnier]

Perso, si j'avais vraiment besoin d'écrire une fonction pour créer les dossiers avec FSO, surtout lors d'un traitement en boucle comme demandé dans la discussion, voici comment je l'écrirais, histoire d'éviter les trois ( )Exit Function (l'un quand la fonction n'est pas nécessaire, l'autre quand la fonction a pu réaliser le travail, le troisième en fin de fonction et qui ne sert donc à rien) et le message intempestif qui va apparaître à chaque fois qu'un dossier n'a pas pu être créé (=> si on s'est trompé sur la racine de la création d'un millier de dossiers, on va se prendre un millier de messages bloquants dans les lattes).

• Je bannis le Exit de mon code!, Définitivement! Ca ne sert à rien qu'à emmêler les pinceaux et ça crée du code spaghetti (surtout lorsque c'est utilisé trois fois).
• Je considère qu'une fonction n'a qu'une seule responsabilité: soit elle tente de créer un dossier, soit elle informe du résultat, mais pas les deux. Dans le code proposé en première réponse, la fonction affiche un message modal, donc bloquant, à chaque problème de création rencontré. Une fonction ne peut pas "faire quelque chose" et en même temps informer l'utilisateur du résultat de l'action tentée, surtout lorsqu'elle est appelée dans une boucle. La fonction renverra plutôt un entier long qui informera du résultat de la tentative, et c'est le code appelant qui informera ou pas l'utilisateur.

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
Function FolderCreate(ByVal path As String) As Long
  Dim fso As New FileSystemObject
 
  If fso.FolderExists(path) Then
    FolderCreate = 1
  Else
    On Error GoTo Catch
    fso.CreateFolder path
  End If
 
Catch:
  If Err <> 0 Then FolderCreate = Err.Number
  Set fso = Nothing
End Function
 
Sub test()
  Dim Result As Long
 
  Result = FolderCreate("c:\data\temp\foldercreate1")
  Select Case Result
    Case 0
      MsgBox "Super. Tout s'est bien passé", vbInformation
    Case 1
      MsgBox "Le dossier existait déjà", vbExclamation
    Case Else
      MsgBox "L'erreur " & Result & " est survenue:" & vbLf & Error(Result), vbCritical
  End Select
End Sub

La fonction peut ainsi être utilisée en boucle de manière silencieuse pour créer des dossiers dont les noms figurent dans un tableau Excel, par exemple, en n'interrompant pas le processus en cas de problème. Lors de la boucle, on pourrait alors pousser le message d'erreur dans un tableau que l'on afficherait en sortie de boucle s'il n'est pas vide. S'il s'agit de créer un seul dossier, on traite directement le résultat de la fonction de création.

Au delà, je précise que je donne ce code à titre d'exemple d'architecture, car comme montré dans ma première réponse, FSO n'est pas nécessaire pour ces opérations et perso, je préfère utiliser les instructions natives du VBA lorsqu'elles sont fonctionnelles.

[Sami_Xite]

Tina Turner vient de m'appeler pour me confirmer que "You're simply the Best !!!"

Mille mercis pour ton aide, tout fonctionne aux petits oignons

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Path = Environ("userprofile") & "\myshare"

[Sami_Xite]

Oups j'ai oublié une dernière chose ...
Comment puis je modifier la macro pour que si f.Value est vide aucun dossier ne soit créé ?

J'ai essayé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
For Each f In Range("folders")
    If Trim(f.Value) <> "" And Dir(Path & "\" & f.Value, vbDirectory) = "" Then MkDir Path & "\" & f.Value
    For Each sf In Range("sub_folders")
      If Dir(Path & "\" & f.Value & "\" & sf.Value, vbDirectory) = "" Then MkDir Path & "\" & f & "\" & sf.Value
        Next
    Next
End Sub

Mais ça coince dès qu'une cellule est vide

Merci encore

Tina Turner vient de m'appeler pour me confirmer que "You're simply the Best !!!"

Mille mercis pour ton aide, tout fonctionne aux petits oignons

[Pierre Fauconnier]

Je n'ai pas repris le temps de tester le code car je n'ai pas gardé le fichier que je t'avais fait, mais ceci devrait convenir. On inclut le bloc de traitement dans un bloc de test (lignes 2 et 7 du code ci-dessous)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
  For Each f In Range("folders")
    If f.Value <> "" Then
      If Trim(f.Value) <> "" And Dir(Path & "\" & f.Value, vbDirectory) = "" Then MkDir Path & "\" & f.Value
      For Each sf In Range("sub_folders")
        If Dir(Path & "\" & f.Value & "\" & sf.Value, vbDirectory) = "" Then MkDir Path & "\" & f & "\" & sf.Value
      Next
    End If
  Next

Cela dit, je me pose la question de la pertinence d'avoir des cellules vides dans un tableau de ce genre

[Sami_Xite]

Encore une fois c'est parfait !!
Pour répondre à ta question sur les cellules vides : Le nom du dossier est calculé sur une feuille à part sur la base des valeurs de plusieurs cellules concaténées et malheureusement certains utilisateurs ne remplissent pas les cellules obligatoires du coup le nom du dossier reste vide.
Donc ma prochaine étape et de trouver un moyen de faire en sorte que les enregistrements ne s'effectuent pas si l'un des champs requis est vide... Si tu as une piste je suis preneur
Mille mercis pour ton aide en tout cas !!!

[Pierre Fauconnier]

N'ayant pas ton fichier ni ton process, je ne comprends pas ce que tu veux dire par "Donc ma prochaine étape et de trouver un moyen de faire en sorte que les enregistrements ne s'effectuent pas si l'un des champs requis est vide"... Je n'ai qu'une réponse à te donner: donner un coup de pied au cul des gens qui ne remplissent pas correctement les données

Cela étant, si le bloc IF END IF résout le problème, c'est bon. Dans la mesure où la procédure teste l'existence du dossier avant de le créer, si l'utilisateur complète par la suite, il suffit de relancer la macro et les noms qui étaient manquants et ne le sont plus permettront de créer les dossiers manquants...