Macro création Dossier\Sous-dossier en concaténant des cellule d'une ligne

Bonjour,

Sur la base du tableau ci-joint j'aimerais créer une macro permettant de créer sur un partage réseau (\\myshare) un dossier et son sous dossier pour chaque ligne selon la règle suivante :

\\myshare\Tableau1[contrat]\Tableau1[folder]

Du coup je me demandais s'il y avait moyen de déclarer une variable ayant pour valeur : \\myshare\Tableau1[contrat]\Tableau1[folder]
Puis de demander à VBA de vérifier l'existence de ce chemin et de créer le dossier "Tableau1[contrat]" et le sous dossier "Tableau1[folder]" le cas échéant.


Merci d'avance pour votre aide

Bonjour,
si le ou les sous dossier existe c'est pas grave!

Code:

---

1 2 3 4 5

Sub test() With CreateObject("Wscript.Shell") .Run "cmd /c mkdir c:\Toto\Toto\Toto\Toto\Toto\Toto\Toto" End With End Sub

---

Bonjour,

Merci pour ta réponse.
Mais comment je déclare le contenu de mes cellules ?

Merci encore

Salut.

Tu peux itérer sur les cellules de la colonne de ton tableau grâce aux références structurées. Du coup, voici qui pourrait convenir:

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

Sub test() Dim Path As String Dim r As Range   Path = "c:\data\temp\" For Each r In Range("tableau1[folder]") CreateFolder Path & r.Value Next End Sub   Function CreateFolder(Path As String) As Long With CreateObject("Wscript.Shell") .Run "cmd /c mkdir " & Path End With End Function

---

Bien entendu, tu pourrais aussi renseigner la racine dans une cellule Excel (idéalement nommée) pour ne pas saisir la valeur en dur dans ton code.


@Thumb: :plusser: pour l'astuce

Pierre je viens de vérifier et shell suffit!

Code:

---

Shell "cmd /c mkdir '" & Path & r.Value & "'"

---

Salut Thumb,

J'espère que tu vas bien...

J'avais testé avec un simple Shell mais j'ai dû mal m'y prendre, car ça ne fonctionnait pas et ça m'ouvrait la fenêtre de commande. Je viens de reprendre le code et tout baigne... :koi:

Code:

---

1 2 3 4 5 6 7 8 9

Sub test() Dim Path As String Dim r As Range   Path = "c:\data\temp\" For Each r In Range("tableau1[folder]") Shell "cmd /c mkdir " & Path & r.Value Next End Sub

---

Merci d'avoir vérifié de ton côté :plusser:

Citation:

---

Envoyé par Pierre Fauconnier

Salut Thumb,

J'espère que tu vas bien...

De mon côté, Shell ne plante pas mais ne crée rien... Par contre, il ouvre la fenêtre de commande... Alors que la solution avec Wscript.Shell fonctionne bien... :koi:

---

oui ça fonctionne pas en réseau ma conclusion était prématuré!

:moinsser: pour moi!

Pas de :moinsser: :ptdr:

Essayer et faire des tests ne mérite pas de moinsser, surtout sur des trucs délicats comme les chemins d'accès réseau ;)...

De plus, je n'étais pas en chemin réseau mais en local avec le chemin donné dans mon code...

Yapluka attendre que Sami_xite nous dise comment ça s'est passé de son côté ;)

Bonjour Pierre, Thumb,

J'ai testé vos 2 codes et je confirme que cela fonctionne parfaitement.
Néanmoins je ne retrouve pas l'arborescence souhaitée, j'ai dû mal m'exprimer :oops:
Pour faire simple sur chaque ligne de mon tableau j'ai une valeur contrat en colonne contrat (tableau1[contrat] ) et une valeur folder (tableau1[folder] )
J'aimerais que pour chaque ligne la macro créée le dossier nommé selon la valeur contrat puis le sous dossier correspondant à la valeur folder
Petite précision : Le contrat n'est pas unique, le folder est une valeur unique

Exemple

Pièce jointe 595202

Devra créer: \\myshare\amazon\folder_amazon
\\myshare\amazon\folder_amazon2
\\myshare\fnac\folder_fnac
\\myshare\cultura\folder_cultura

Merci à vous 2 :ccool:

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14

Sub test() Const Path As String = "[folder]\[comment]\[contrat]" With ThisWorkbook.Sheets("Feuil1") For i = 2 To .Range("A1").CurrentRegion.Rows.Count CreateFolder Replace(Replace(Replace(Path, "[folder]", .Cells(i, "A")), "[comment]", .Cells(i, "B")), "[contrat]", .Cells(i, "C")) Next   End With End Sub Function CreateFolder(Path As String) As Long With CreateObject("Wscript.Shell") .Run "cmd /c mkdir " & Path End With End Function

---

Salut

Tu dois simplement constituer le chemin du dossier en incluant d'abord le contrat puis le folder. Sur base du tableau structuré illustré plus tôt et en utilisant les références structurées pour ne pas "verrouiller" le tableau en A1:

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

Sub test() Dim Path As String Dim i As Long   Path = "c:\data\temp\" For i = 1 To Range("tableau1").Rows.Count CreateFolder Path & Range("tableau1[contrat]")(i).Value & "\" & Range("tableau1[folder]")(i).Value Next End Sub   Function CreateFolder(Path As String) As Long With CreateObject("Wscript.Shell") .Run "cmd /c mkdir " & Path End With End Function

---

Bonjour Pierre, Thumb

Lorsque j'execute la macro j'ai effectivement tout un tas de fenêtre DOS qui s'affichent, moyen de ne pas l'afficher ?
Si la valeur contrat ou folder contient un espace le nom du dossier est tronqué.
Ex : contrat : amazon france
Il me crée le répertoire amazon

Merci et bon WE !!!

Au départ, j'avais accepté l'idée du Shell qui crée tout le chemin s'il n'existe pas, mais je vais proposer le code suivant, qui va repartir du root et tester l'existence des dossiers, toujours avec le même tableau de départ. On part de l'idée que le Root existe. Du coup, plus de fenêtres de commande intempestives et les espaces passent sans soucis ;). De plus, on reste dans du VBA pur, ce que je préfère à l'appel d'outils extérieurs lorsque l'on peut s'en passer ;)

Pièce jointe 595391

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13

Sub CreateFolder() Dim Root As String Dim i As Long Dim Path As String   Root = "c:\Data\Temp\Contrats\" For i = 1 To Range("t_folders").Rows.Count Path = Root & Range("t_Folders[Contrat]")(i).Value If Dir(Path, vbDirectory) = "" Then MkDir Path Path = Path & "\" & Range("t_folders[Folder]")(i).Value If Dir(Path, vbDirectory) = "" Then MkDir Path Next End Sub

---

Merci Pierre, c'est exactement ce qu'il me fallait :ccool::hola:
Une dernière question : Comment exclure la création de dossier si t_Folders[Contrat] est vide ?
J'ai essayé en mettant : If i.value <> "" mais j'ai une erreur de compilation

Muchas Gracias

i est un entier long qui pointe sur chaque ligne du tableau grâce à la boucle. Tu dois donc t'en servir dans la boucle pour tester la valeur de la colonne Contrat de la ième ligne du tableau. Si j'ai bien compris ta demande, tu peux donc encadrer le process d'un test sur la cellule contrat.

Voici le code commenté

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

Sub CreateFolder() Dim Root As String Dim i As Long Dim Path As String Root = "c:\Data\Temp\Contrats\" ' Chemin de départ For i = 1 To Range("t_folders").Rows.Count ' On boucle avec i de 1 à Nbre de lignes du tableau If Range("t_Folders[Contrat]")(i).Value <> "" Then ' On teste si la cellule Contrat n'est pas vide pour la ligne sur laquelle la boucle passe Path = Root & Range("t_Folders[Contrat]")(i).Value ' On récupère le nom du contrat pour reconstituer le nom du chemin If Dir(Path, vbDirectory) = "" Then MkDir Path ' On teste si ce dossier existe. Si non, on le crée Path = Path & "\" & Range("t_folders[Folder]")(i).Value ' On complète le chemin avec le nom du folder If Dir(Path, vbDirectory) = "" Then MkDir Path ' On teste si le dossier existe. S'il n'existe pas, on le crée End If Next ' On passe à la ligne suivante jusqu'à la dernière End Sub

---

La mécanique mise en place va donc boucler sur i qui va passer de 1 à 6 sur base du tableau illustré précédemment. Il faut bien noter que i pointe vers les lignes du tableau. Donc lorsque i vaut 1, on pointe vers la première ligne du tableau qui, toujours sur base de l'exemple, est en ligne 2 de la feuille. C'est tout l'intérêt de travailler avec des tableaux structurés. Tu peux les déplacer où tu veux sans toucher au code car les i bouclent sur les lignes du tableau et pas de la feuille.

Voilà une illustration qui montre que quelle que soit la place du tableau, les indices des lignes ne changent pas. Ca donne beaucoup de souplesse au code.

Pièce jointe 595437

Bonjour Pierre,

Merci d'avoir pris le temps de m'expliquer le fonctionnement, du coup je commence à mieux comprendre
J'ai adapté ton code de la manière suivante pour automatiser la création d'un sous dossier "GENERAL" et d'autres sous dossiers dans celui-ci

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

Sub CreateContract() Dim Root As String Dim i As Long Dim g As String Dim sf As Range Dim Path As String Dim gPath As String     Root = "\\myshare\" g = "GENERAL" For i = 1 To Range("Folders").Rows.Count Path = Root & Range("Folders[Contract_Folder]")(i).Value If Range("Folders[Contract_Folder]")(i).Value <> "" Then If Dir(Path, vbDirectory) = "" Then MkDir Path gPath = Path & "\" & g If Dir(gPath, vbDirectory) = "" Then MkDir gPath For Each sf In Range("subcontract") Path = gPath & "\" & sf.Value If Dir(Path, vbDirectory) = "" Then MkDir Path Next Next End Sub

---

Mais j'ai une erreur "Next without For" :oops:. J'ai vraiment du mal avec les boucles en VBA

Merci et bonne journée

Salut,

Si je peux me permettre 'intervenir dans cette discussion de haut vol pour répondre à la dernière question.

Il doit te manquer une instruction End If ou bien Next ...
D'où l'importance de
- bien indenter son code (=décaler le contenu des blocs If, Next, Do...)
- préciser dans l'instruction Next le paramètre pris en compte (For Each c...Next c).
Et ce même si celui-ci est tacite. Le code n'en sera que plus lisible et, partant, plus aisément modifiable

Une indication

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

Option Explicit   Sub CreateContract()   Dim Root As String Dim i As Long Dim g As String Dim sf As Range Dim Path As String Dim gPath As String   Root = "\\myshare\" g = "GENERAL" For i = 1 To Range("Folders").Rows.Count Path = Root & Range("Folders[Contract_Folder]")(i).Value If Range("Folders[Contract_Folder]")(i).Value <> "" Then If Dir(Path, vbDirectory) = "" Then MkDir Path gPath = Path & "\" & g If Dir(gPath, vbDirectory) = "" Then MkDir gPath For Each sf In Range("subcontract") Path = gPath & "\" & sf.Value If Dir(Path, vbDirectory) = "" Then MkDir Path Next sf End If Next i   End Sub

---

J'ai bien dit "indication", car je n'ai pas cherché à connaître la logique du développement, du moins pour l'instant.

Bonjour Pierre, MarcelG

Désolé pour le retour tardif suite à un petit soucis perso ( rien à voir avec la Covid :lol: ).
Merci pour votre aide précieuse, problème résolu :ccool::applo:

Bon WE prolongé