XL 2013 Ajouter des dossiers dans une arborescence

Jacques25

XLDnaute Occasionnel
Bonjour à tous,

Après quelques recherches sur le forum je m'en remets à vous. J'ai une arborescence de 500 à 600 dossiers tous construit de la même manière (Dossier et Titre sont des dossiers et dans chaque dossier nommé titre dans l'exemple se trouve des fichiers) :
Dossier A
01 titre 1
02 titre 2
03 titre 3
Dossier B
01 titre 1
02 titre 2
03 titre 3
Dossier C
01 titre 1
02 titre 2
03 titre 3
...

Ma question :
Dans mes 5 ou 600 dossiers (A, B, C...) je souhaiterai rajouter 1 dossier vide nommé 04 titre 4.

Pensez vous que c'est faisable?
et la question d'après vous vous en doutez : si oui comment fait on?

Merci d'avance de votre aide.

Jack
 

Hieu

XLDnaute Impliqué
Re : Ajouter des dossiers dans une arborescence

Salut,

En pièce jointe une macro qui te permet de réaliser ce que tu veux.
A adapter selon besoin.

Code:
Sub creation_dossiers()
chemin = ThisWorkbook.Path & "\"
For i = 1 To Range("c2")
MkDir (chemin & Range("b2").Offset(i, 0) & "\04_TITRE_4\")
Next i
End Sub
++
 

Fichiers joints

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Ajouter des dossiers dans une arborescence

Bonsoir Jacques25, Hieu,

Un autre essai:
.
  • sauvegardez le fichier AjoutDossier.xls dans le dossier racine contenant tous vos dossiers A, B, C...
  • lancez ce fichier AjoutDossier.xls
  • indiquez en A2 le nom du nouveau dossier à créer
  • cliquez sur le bouton "C'est parti !"

Le code:
VB:
Sub AjouterDossier()
Dim xRacine, xRep, NouveauDossier
  NouveauDossier = Trim(Range("a2"))
  If Left(NouveauDossier, 1) <> "\" Then NouveauDossier = "\" & NouveauDossier
  If NouveauDossier <> "\" Then
    xRacine = ThisWorkbook.Path
    ChDrive Left(xRacine, 1)
    If Right(xRacine, 1) <> "\" Then xRacine = xRacine & "\"
      xRep = Dir(xRacine & "*.*", vbDirectory)
      On Error Resume Next
      Do While xRep <> ""
        If xRep <> "." And xRep <> ".." Then
          If GetAttr(xRacine & xRep) = vbDirectory Then
            MkDir xRacine & xRep & NouveauDossier
          End If
        End If
        xRep = Dir
      Loop
  End If
MsgBox "C'est terminé.", vbInformation
End Sub

Edit : nouvelle version - le code n'a pas changé - juste remplacé dans la cellule A2 le texte WWWW par 04 titre 4 pour un peu plus de cohérence dans les explications!
 

Fichiers joints

Dernière édition:

Jacques25

XLDnaute Occasionnel
Re : Ajouter des dossiers dans une arborescence

Bonsoir Hieu, Mapomme,

Merci pour vos codes, je vais tester et vous retiens au courant. J'vais gagner bcp de temps ;-)

Bon week end à tous

Jack
 

Jacques25

XLDnaute Occasionnel
Re : Ajouter des dossiers dans une arborescence

Bonjour à tous,

Désolé de ne répondre que maintenant mais j'ai pas pu tester avant, ça marche nickel.
Merci beaucoup pour votre aide.

Bonne journée à tous.

Jack
 

Jacques25

XLDnaute Occasionnel
Bonjour à tous,

Je déterre un sujet de 2016 qui marchait bien à l'époque, j'ai voulu relancer mon code et j'ai le message d'erreur suivant
"Argument ou appel de procédure incorrect"
Pour être sûr j'ai recopié le fichier de Mapomme et j'ai le même message. Est ce que ça peut venir de la version d'Excel? si oui comment puis-je modifier pour ça marche.

Merci de votre compréhension.
@ plus

Jack
 

job75

XLDnaute Barbatruc
Bonjour Jacques25,

Sur Win 10 - Excel 2013 tout se passe bien chez moi.

Quelle est votre version Excel et quel est le code qui beugue ?

A+
 

Jacques25

XLDnaute Occasionnel
Bonjour Job75,

J'ai excel 2013 aussi le code bloque au niveau du Chdrive.
C'est une arborescence qui se trouve sur un serveur si ça peut être la cause. mais depuis 2016 il n'a pas bougé et ça marchait...

Merci d'avance de votre aide.
@ plus

Jack
 

Jacques25

XLDnaute Occasionnel
Salut Job75,

C'est une solution mais si je le vire il me créé un dossier du même nom avec au bout le nom du dossier que je veux créer :-(

@ plus
Jack
 

Jacques25

XLDnaute Occasionnel
Bonjour Roland_M

En fait j'ai plus de 800 dossiers avec déjà 24 sous-dossiers dans chacun et je voudrais en créer un 25ème. Tous ces dossiers se trouvent sur un serveur.
Qu'entends tu par : il n'est peut être pas nécessaire de te placer sur le réseau?
Est ce qu'il faut que je mette le fichier direct sur mon PC et que j'indique le chemin complet?

J'ai regardé le lien que tu m'as fourni, c'est bien trop compliqué, j'ai pas compris grand chose.

A quoi sert le Chdrive?

Merci à tous de votre aide.
Bonne journée

Jack
 

Roland_M

XLDnaute Barbatruc
re

aïe aïe aï ! effectivement ça ne va pas être facile !

A quoi sert le Chdrive?
chdrive c'est rendre un lecteur actif: exemple chdrive "e:" il ne se passe rien d'autre !
chdir c'est idem mais cette fois sur un chemin de ce lecteur actif !

Qu'entends tu par : il n'est peut être pas nécessaire de te placer sur le réseau?
Est ce qu'il faut que je mette le fichier direct sur mon PC et que j'indique le chemin complet?
non !
mais à chaque appel on met le nom complet du fichier et du chemin
supposons open"FichierSeul" le fichier est sensé se trouver sur le path en cours !
sinon il faut préciser à chaque fois le chemin complet exp: "c:\dossier1\dossier2\MonFichier"
 

Jacques25

XLDnaute Occasionnel
Re bonjour à tous,

J'ai enfin solutionné mon problème, ça marchait sur un dossier sur un autre serveur, j'ai donc extrait dans une cellule le Thisworbook.path et je me suis rendu compte que le chemin ne commençait pas par la lettre pour celui qui ne marchait pas alors que l'autre oui. Du coup j'ai saisie l'adresse du serveur en lui affectant la bonne lettre.

Merci d'avoir passé un peu de temps sur mon cas.
Bonne journée à tous.

Jack
 

Roland_M

XLDnaute Barbatruc
re

eh bien voilà ! je suis content pour toi !
mais, on ne perd jamais son temps, quand on échange on apprend toujours qq chose !

bonne journée et au plaisir !
 

Dydou76

XLDnaute Junior
bonsoir,

j'ai un p'tit souci.
dans mon programme j'ai un txbox qui demande dans quel dossier enregistrer la feuille et si se dossier n'existe pas il le créé.
jusque là ça marche tres bien, mais si se dossier existe dejas j'aimerai qu'il l'enregistre dans ce dossier deja existant mais il ne le fait pas
voila mon code:
NomDossier = Application.InputBox("Dossier Enregistrement :", "Dossier")
CheminDossier = "C:\Users\*********\Documents\***\Sauvegarde\" & NomDossier & "\"
If Dir(CheminDossier, vbDirectory) <> vbNullString Then
Else
MkDir (CheminDossier)

Merci pour votre aide
 

Discussions similaires


Haut Bas