Crée des dossiers et sous dossiers automatiquement

Bonjour le Forum,

J'ai 300 dossiers à crée à la main avec dedans 6 sous dossiers, auriez-vous une solution s'il vous plait?

Par avance, merci.

Cordialement.

ericp

Bonjour

oui cela est possible...

encore faut-il savoir le nom des 300 dossiers et sous dossiers.... et le répertoire de depart....

les sous-dossiers ont tous la même structure et donc les mêmes noms ???

Fred

voir ici pour une fonction qui fait la création d'un dossier si il n'existe pas :

https://forum.excel-pratique.com/excel/verifier-existance-dossier-sinon-le-creer-83603#p484369

fonction :

test_repertoire

Fred

Bonjour Ericp, Fred2406,

Exemple fait sur le répertoire Images.

Sub Création()
For Num = 1 to 300
ChDir (C:\Users\utilisateur\Pictures")
Doss="Dossier" & Num
MKdir (Doss)
ChDir (C:\Users\utilisateur\Pictures" & Doss)
For Chf = 1 to 6
Sdoss = "SousDossier" & Chf
MkDir (Sdoss)
Next Chf
Next Num
End sub

A adapter en fonction des noms Utilisateur, Dossier et Sous-Dossier. Utiliser le recours à un tableau, sur une feuille afin d'en récupérer des cellules précédemment renseignées.

Bonjour X Celus,

Cela ne fonctionne pas, cela me mets en rouge 'ChDir (C:\Users\utilisateur\Nouveau dossier")'

Sub Création()
For Num = 1 To 300
ChDir (C:\Users\utilisateur\Nouveau dossier")
Doss = "Dossier" & Num
MkDir (Doss)
ChDir (C:\Users\utilisateur\Nouveau dossier" & Doss)
For Chf = 1 To 6
Sdoss = "SousDossier" & Chf
MkDir (Sdoss)
Next Chf
Next Num
End Sub

A nouveau,

Je pars d'un répertoire existant, celui d'images (Pictures)

Donc si ton répertoire de départ n'existe pas il faut le créer. Sinon ChDir ne le t.rouvera pas et ne pourra pas s'y positionner.

Ensuite quel est le nom ou prénom d'utilisateur.

suite,

tu peux utiliser ce code pour connaitre l'utilisateur

Sub client()
Dim nom as string
nom = Environ("HomePath")
' Soit faire un stop et passer la souris sur nom
Stop
' Ou inscrire dans une cellule de feuille
Range("A1")=nom
End sub

Après plusieurs essais négatif, j'ai été sur le net et ai trouvé ce programme sauf qu'il me met que sur 2 colonnes et il m'en faut 6.

Est ce que vous pourriez compléter ce programme s'il vous plait.

Je vous remercie par avance de votre gentilesse.

cordialement.

ericp

Option Explicit

Public Sub Créer_reps()
Dim lig As Long, rep As String, nbc(3)
Dim CHX As FileDialog ' selection Repertoire
Set CHX = Application.FileDialog(msoFileDialogFolderPicker)
CHX.Show
On Error Resume Next
rep = CHX.SelectedItems(1)
If Err.Number <> 0 Then Exit Sub
For lig = 2 To Cells(Rows.Count, 1).End(xlUp).Row
MkDir (rep & "\" & Cells(lig, 1).Value)
If Err.Number = 0 Then nbc(1) = nbc(1) + 1 Else Err.Clear
MkDir (rep & "\" & Cells(lig, 1).Value _
& "\" & Cells(lig, 2).Value)
If Err.Number = 0 Then nbc(2) = nbc(2) + 1 Else Err.Clear
If Cells(lig, 3).Value <> "" Then
MkDir (rep & "\" & Cells(lig, 1).Value _
& "\" & Cells(lig, 3).Value)
If Err.Number = 0 Then nbc(3) = nbc(3) + 1 Else Err.Clear
End If
Next lig
MsgBox nbc(1) & " Dossiers créés" & vbLf _
& nbc(2) & " Sous-dossiers 1 créés" & vbLf _
& nbc(3) & " Sous-dossiers 2 créés"
End Sub

A nouveau,

Je comprends que tes essais n'ont pas aboutis. Car en retapant le code sur ce site j'ai oubliè un anti-slahs donc \ sur le 2ième ChDir qui réalise les sous-dossiers.

Désolé pour ce contre-temps.

Je remets le code corrigé. Vérifier que dans le répertoire de départ il n'existe pas de dossiers créés. Donc que le répertoire de départ est vide.

Voici,

Sub Création()
For Num = 1 to 300
ChDir ("C:\Users\utilisateur\Pictures")
Doss="Dossier" & Num
MKdir (Doss)
ChDir ("C:\Users\utilisateur\Pictures\" & Doss)  'ici il manquait un \ en fin de Pictures.
For Chf = 1 to 6
Sdoss = "SousDossier" & Chf
MkDir (Sdoss)
Next Chf
Next Num
End sub

Remplace Pictures par ton répertoire initial ou vont se loger les 300 dossiers et leurs 6 sous-dossiers.

Remplace utilisateur par l'utilisateur du PC.

Re bonjour ...

un fichier avec 4 lignes et ce que tu souhaitais comme dossier et sous dossier avec une petite explication aurait été tellement plus simple.....

Fred

Chemin d'acces introuvable, et j'ai bien suivi tes instructions

suite,

Tu crée sur un Pc personnel je suppose

Chemin d'accès c'est une lettre de disque puis Users puis le nom d'utilisateur puis le répertoire ou tu veux faire les opérations.

J'ai encore testé sur mon ordi. Et aucun souci.

Re bonjour ...

je vais de nouveau insister...

un fichier avec 4 lignes et ce que tu souhaitais comme dossier et sous dossier avec une petite explication aurait été tellement plus simple.....

Fred

Excuse moi, mais je ne comprends rien, j'essaye et ça me beug, la macro que j'ai mis n'a pas besoin de chemin.

Bonjour,

J'ai trouvé la solution, cela a été laborieux mais c'est bon.

Merci pour tout.

Cordialement.

ericp

Option Explicit

Public Sub Créer_reps()
Dim lig As Long, rep As String, nbc(3)
Dim CHX As FileDialog ' selection Repertoire
Set CHX = Application.FileDialog(msoFileDialogFolderPicker)
CHX.Show
On Error Resume Next
rep = CHX.SelectedItems(1)
If Err.Number <> 0 Then Exit Sub
For lig = 2 To Cells(Rows.Count, 1).End(xlUp).Row
MkDir (rep & "\" & Cells(lig, 1).Value)
If Err.Number = 0 Then nbc(1) = nbc(1) + 1 Else Err.Clear
MkDir (rep & "\" & Cells(lig, 1).Value _
& "\" & Cells(lig, 2).Value)
If Err.Number = 0 Then nbc(2) = nbc(2) + 1 Else Err.Clear
If Cells(lig, 3).Value <> "" Then
MkDir (rep & "\" & Cells(lig, 1).Value _
& "\" & Cells(lig, 3).Value)
MkDir (rep & "\" & Cells(lig, 1).Value _
& "\" & Cells(lig, 4).Value)
MkDir (rep & "\" & Cells(lig, 1).Value _
& "\" & Cells(lig, 5).Value)
MkDir (rep & "\" & Cells(lig, 1).Value _
& "\" & Cells(lig, 6).Value)
MkDir (rep & "\" & Cells(lig, 1).Value _
& "\" & Cells(lig, 7).Value)

If Err.Number = 0 Then nbc(3) = nbc(3) + 1 Else Err.Clear
End If
Next lig
MsgBox nbc(1) & " Dossiers créés" & vbLf _
& nbc(2) & " Sous-dossiers 1 créés" & vbLf _
& nbc(3) & " Sous-dossiers 2 créés"
End Sub

Bonjour Ericp,

la macro que j'ai mis n'a pas besoin de chemin.

Pour réaliser la création de tes dossiers et sous-dossiers, il te faut un chemin. Seulement avec

Dim chx As FileDialog
Set chx = Application.FileDialog(msoFileDialogFolderPicker)
chx.Show
On Error Resume Next
rep = chx.SelectedItems(1)

c'est rep qui conserve le chemin que tu recherches en explorant l'arborescence de ton pc.

Donc un ChrDir(rep) t'aurait placé ensuite au bon endroit. Tu souhaitais t'économiser de taper le chemin en entier.

Ravi de ta réussite, maintenant il va falloir remplir tous ces dossiers et pas perdre leur chemin.

re-bonjour X Cellus

Tu souhaitais t'économiser de taper le chemin en entier

Je ne savais pas faire, par ou commencer, ce que je devais chercher et ou aller, j'étais perdu.

Vous sur le site, vous êtes des super pro d'excel tandis moi comme ici, ne sommes que des novices, je bidouille, des fois ça marche des fois non.

merci pour tout.

cordialement.

ericp

A nouveau,

En effet parfois pour des actes que l'on trouve simple ceux-ci sont moins faciles à comprendre.

Mais au moins cela t'auras fais avancer. On apprend toujours, l'important est de ne pas oublier.

A plus.

Rechercher des sujets similaires à "cree dossiers automatiquement"