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

++
 

Pièces jointes

  • creation_sous_dossier_v0.xlsm
    18.5 KB · Affichages: 53

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!
 

Pièces jointes

  • AjoutDossier.xls
    39 KB · Affichages: 69
  • RACINE.zip
    16.8 KB · Affichages: 55
Dernière édition:

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
 

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
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
 

Discussions similaires

Réponses
2
Affichages
486

Statistiques des forums

Discussions
311 721
Messages
2 081 929
Membres
101 843
dernier inscrit
Thaly