Si vous avez besoin de créer un nouveau dossier avec VBA, vous pouvez utiliser le code de la fonction qui suit. Son grand avantage par rapport à la plupart des solutions qui circulent sur internet réside dans le fait qu’il peut créer non seulement un nouveau dossier mais également ses sous-dossiers. Un gain de temps et de sérénité garanti!
Sommaire
Créer dossiers et sous-dossiers en VBA: comment ça marche?
Prenons un exemple pour illustrer la situation: Nous avons le dossier « C:\Temp » qui ne contient aucun sous-dossier.
Avec les codes habituels vous pouvez créer le dossier « C:\Temp\MonDossier » mais si vous voulez créer directement « C:\Temp\MonDossier\MonSousDossier » cela ne sera pas possible. La plupart des solutions ne peuvent pas créer des sous-dossiers dans un dossier qui n’existe pas encore.
Le code VBA que je vous propose peut créer des sous-dossiers dans des dossiers inexistants. Dans notre exemple, avec le code VBA sur cette page, la fonction va créer le dossier « C:\Temp\MonDossier » et ensuite le sous-dossier « MonSousDossier », tout cela dans une seule instruction, de manière tout à fait automatique.
Le nombre de niveaux de sous dossier n’est pas limité. Il s’agit donc d’une solution idéale pour créer des nouvelles structures complètes de dossiers et sous-dossiers.
Suite à une remarque dans les commentaires, j’ai adapté le code pour qu’il fonctionne également sur les lecteurs en réseau (chemin du type “\\NomReseau\NomDossier\NomSousDossier”)…
Voici donc le code de la fonction prêt à l’emploi suivi d'un exemple d'utilisation.
Fonction VBA MkDir() pour créer un simple répertoire
Pour créer un simple dossier, on peut se satisfaire de la fonction VBA de base MkDir() qui utilise un argument (de type String
) qui contient le nom et l'emplacement du nouveau dossier. Le désavantage de cette fonction réside dans le fait qu'il est possible de créer un dossier seulement dans un dossier déjà existant.
1 |
MkDir("C:\Test\MonDossier1\") |
Cette solution est suffisante si vous avez besoin d'ajouter un seul dossier. Simple et efficace.
Fonction VBA pour créer des dossiers et des sous-dossiers en même temps
Si, contrairement à l'exemple précédent, vous avez besoin de créer plusieurs niveaux de sous-dossiers, les fonctions de base de VBA ne seront pas suffisantes. Il vous faudra créer votre propre fonction. Ou plus simple: utiliser la fonction suivante…
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 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 |
Function CreerDossier(Chemin As String) 'par: Excel-Malin.com ( https://excel-malin.com ) On Error GoTo CreerDossierErreur Dim PremierDossier As String Dim CheminReseau As Boolean Dim CheminPartielOK As String Dim CheminPartiel, PartieDeChemin As Integer Dim PartiesDeChemin As Variant Dim FSO As Object Set FSO = CreateObject("Scripting.FileSystemObject") If Len(Dir(Chemin, vbDirectory)) > 0 Then CreerDossier = True Exit Function Else 'suppression du dernier backslash si présent If Right(Chemin, 1) = Application.PathSeparator Then Chemin = Left(Chemin, Len(Chemin) - 1) 'vérificacion si chemin local ou réseau If Left(Chemin, 2) = "\\" Then CheminReseau = True Else CheminReseau = False End If 'décomposition du chemin If CheminReseau = False Then PartiesDeChemin = Split(Chemin, Application.PathSeparator) CheminPartielOK = "" PremierDossier = LBound(PartiesDeChemin) Else PartiesDeChemin = Split(Replace(Chemin, "\\", ""), Application.PathSeparator) CheminPartielOK = "" PremierDossier = LBound(PartiesDeChemin) + 1 End If 'tests et créations de (sous)dossiers For PartieDeChemin = PremierDossier To UBound(PartiesDeChemin) For CheminPartiel = LBound(PartiesDeChemin) To PartieDeChemin If CheminReseau = False Then CheminPartielOK = CheminPartielOK & PartiesDeChemin(CheminPartiel) & Application.PathSeparator Else CheminPartielOK = CheminPartielOK & PartiesDeChemin(CheminPartiel) & Application.PathSeparator End If If CheminPartiel = PartieDeChemin Then If CheminReseau = False Then If FSO.FolderExists(CheminPartielOK) = False Then MkDir CheminPartielOK End If Else If Right(CheminPartielOK, 1) = Application.PathSeparator Then _ CheminPartielOK = Left(CheminPartielOK, Len(CheminPartielOK) - 1) If Left(CheminPartielOK, 2) <> "\\" Then _ CheminPartielOK = "\\" & CheminPartielOK If FSO.FolderExists(CheminPartielOK) = False Then MkDir CheminPartielOK End If End If End If Next CheminPartiel CheminPartielOK = "" Next PartieDeChemin End If CreerDossier = True Exit Function CreerDossierErreur: CreerDossier = False End Function |
Exemple pratique d'utilisation de la fonction VBA
Voici donc un exemple de code VBA qui utilise la fonction que je vous propose plus haut pour créer un dossier (MonDossier) ainsi que des sous-dossier en 3 niveaux. Tout cela crée dans le dossier "Temp" qui se trouve sur le disque C: .
Comme vous pouvez le voir, cela peut difficilement être plus simple et plus "user-friendly"!
1 2 3 4 5 6 7 8 9 10 11 |
Sub ExempleCreationDossierAvecSousdossiers() 'par: Excel-Malin.com ( https://excel-malin.com ) On Error GoTo ExempleErreur Dim NouveauDossierAvecSousDossiers As String NouveauDossierAvecSousDossiers = "C:\Temp\MonDossier\MonSousDossier\Niveau_3\Niveau_4" 'vous pouvez remplacer cette valeur par votre dossier CreerDossier (NouveauDossierAvecSousDossiers) Exit Sub ExempleErreur: MsgBox "Une erreur est survenue..." End Sub |
Ceci devrait rendre votre travail plus rapide et plus efficace! Que ce soit un simple classement de fichiers ou la création d'une application VBA.
Pour aller plus loin en Excel et en VBA
Pout terminer, je vous propose quelques autres articles qui pourraient vous être utiles et vous faire gagner du temps:
- VBA: vérifier si le dossier existe
- VBA: copier un dossier et son contenu
- VBA: Ouvrir dossier dans Windows Explorer
- Manipulation des fichiers via VBA
- Liste de toutes les fonctions disponibles en VBA
- RECHERCHEV en VBA – oui, c'est possible!
- Cours VBA en ligne – "VBA: Droit au but"
21 commentaires sur “Création des dossiers et sous-dossiers en VBA”
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim fl1 As String, fl2 As String, fl3 As String, fl4 As String, w1 As String, w2 As String, w3 As Workbook
Application.ScreenUpdating = False
w1 = ThisWorkbook.FullName ' Fichier Original
w2 = ThisWorkbook.Name ' "ABC.xlsm"
Set w3 = ThisWorkbook ' ThisWorkbook "C:\Documents and Settings\NomUtilisateur\Mes documents"
fl2 = "\" ' "\"
fl1 = fl2 & "Sauv" ' \Sauv
fl3 = fl2 & Format(Now, "yy-mm-dd") ' "\Date Du Jour"
fl4 = fl2 & Left(w2, (InStrRev(w2, ".") – 1)) ' "\ABC" Only ABC from ABC.xlsm
' myName = Left (ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".") – 1))
' ext = Right(ThisWorkbook.Name, Len(ThisWorkbook.Name) – InStrRev(ThisWorkbook.Name, "."))
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
w3.Path & fl2 & w2, FileFormat:=xlOpenXMLWorkbookMacroEnabled, AccessMode:=xlShared 'w3.Path sauvegarde même dossier
If Dir(w3.Path & fl1, 16) = "" Then
MkDir (w3.Path & fl1)
MkDir (w3.Path & fl1 & fl3 & "")
MkDir (w3.Path & fl1 & fl3 & fl4)
ElseIf Dir(w3.Path & fl1 & fl3 & "", 16) = "" Then
MkDir (w3.Path & fl1 & fl3 & "")
MkDir (w3.Path & fl1 & fl3 & fl4)
ElseIf Dir(w3.Path & fl1 & fl3 & fl4, 16) = "" Then
MkDir (w3.Path & fl1 & fl3 & fl4)
End If
ActiveWorkbook.SaveAs Filename:= _
w3.Path & fl1 & fl3 & fl4 & fl2 & Format(Now, "hhnnss") & "_" & w2, FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, AccessMode:=xlShared '\Sauv sauvegarde dans un autre dossier
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Superbe solution pour le fondement d'une copie avec création de dossiers multiples.
Voici une version qui ne modifie Chemin que j'ai renommé CheminTemp et avec déclaration des variables :
Bonjour,
Votre code est super mais je suis confrontée à une complexité :
Je fais du VBA sur access, et je ne suis pas une pro d'access.
Je veux créer des sous-répertoires qui prendraient comme nom la valeur d'une ligne de ma colonne :
Ex : ma Table client liée à sharePoint possède 10 colonnes et 3000 lignes.
La 2ème colonne correspond au numéro de compte client. J'ai 3000 clients
Pour chaque client, je voudrais qu'un sous-répertoire soit créé en prenant le numéro de compte client, et je ne sais pas exactement comment faire.
Je ne peux pas appliquer votre code et c'est bien dommage.
Est-ce que vous avez une piste ?
Merci !
A
Bonjour,
vous pouvez utiliser le code de mon article mais vous avez besoin d'une procédure qui fera la boucle et déclenchera la fonction
CreerDossier
.Voici comment procéder:
– prenez un nouveau fichier Excel et nommez une feuille "clients"
– dans cette feuille, copiez dans la colonne A les 3000 numéros de clients
– ajoutez un
Module
dans votre projet VBA et copiez y le code de la fonctionCreerDossier
de mon article– ajoutez y également la procédure suivante:
– changez le dossier commun dans le code (j'ai mis un exemple)
– ensuite, lances la procédure
RepertoiresClients
– quelques instants après, vous aurez vos 3.000 dossiers qui se trouveront dans le répertoire commun…
J'espère que cela va résoudre votre problème.
Cordialement, Martin
Bonjour,
J'ai utilisé votre fonction, pour créer plusieurs répertoires et sous répertoires selon une boucle.
Je ne sais pour quelle raison, mais le répertoire "racine" qu'elle a créé nécessite des droits admin si on veut pouvoir le supprimer par la suite.
Savez vous comment est-ce possible? Est il possible de désactiver cette fonctionnalit2?
Merci
Bonjour Guillaume,
à vrai dire, je n'ai pas encore rencontré ce cas de figure.
En tout cas, ce n'est pas une fonctionnalité de la macro. Cela doit être lié au setup de votre windows. Quel version d'Excel / Windows utilisez-vous?
Cela se produit avec chaque dossier racine que vous avez crée ou seulement dans des cas spécifiques?
Bàv, Martin
Bonjour,
Merci pour ce code, j'ai rencontre un souci aléatoirement on dirait.
J'ai l'impression que lorsque mon lien du dossier est sous la forme C:\…. cela fonctionne mais par contre en réseau avec un lien \\nomreseau\dossier1\… ne fonctionne pas.
Voici comment je défini le chemin :
NouveauDossierAvecSousDossiers = ThisWorkbook.Path & FamilyFolder & "\" & MainSerialNumber
CreerDossier (NouveauDossierAvecSousDossiers)
Merci de votre aide
Bonjour Ethan,
en effet, ce code n'était pas prévu pour l'utilisation avec des disques en réseau (il datait de l'époque où le travail en réseau n'était pas si répandu).
J'ai donc décidé de refaire le code pour qu'il soit adapté à la situation actuelle…
C'était plutôt "complexe" comme modification mais j'y suis arrivé 😉
Vous trouverez donc le nouveau code dans l'article. Je l'ai testé et il fonctionne en réseau et en local.
Cordialement, Martin
Super. Cela fonctionne parfaitement. J'aimerais bien que mes problèmes "complexes" prennent autant de temps à être résolu :-).
Merci.
Avec plaisir…
Bonjour, je suis très intéressé par ce code (création d'un sous dossier dans un dossier) mais je débute dans la programmation VBA, alors j'ai copié votre code dans un classeur, fonction et plus bas la macro j'ai ensuite modifié le chemin ou je veux le dossiers et le sous dossier, mais au lancement de la macro il ne se passe rien . (j'espère que je me suis bien exprimé)
Cordialement
Bonjour,
en complément avec Option Explicit :
Dim PremierDossier As String
Dim CheminReseau As Boolean
Dim CheminPartielOK As String
Dim CheminPartiel, PartieDeChemin As Integer
Dim PartiesDeChemin As Variant
Oui, en effet, 🙂
Merci pour la remarque. Je l'ajoute au code.
Cordialement, Martin
Bonjour,
Intéressante comme fonction.
Cependant, en essayant de l'utiliser, LIGNE 19 j'ai le message d'erreur de compilation suivant: "Membre de méthode ou de donnés introuvable."
Devrais-je ajouté une librairie à mon projet.
J'utilise Office 365.
Cordialement.
Bonjour PAMPHILE,
normalement, aucune référence particulière n'est nécessaire. Je viens de le tester en Office 365 sans référence et cela marche.
Mais essayez tout de même de cocher la référence
Microsoft Scripting Runtime
. Si cela marche, pouvez vous me le confirmer? Ainsi je l'ajjouterai dans le tutoriel pour que les autres n'aient pas le même soucis.Cordialement, Martin
Bonjour,
Merci ce code est très pratique et fonctionnel et votre site est une bible pour un novice comme moi.
Si je souhaite que le nom du dossier ou d'un sous-dossier soit la valeur de une ou plusieurs cellules, comment dois-je l'indiquer dans le chemin du NouveauDossierAvecSousDossier ?
J'ai tenté ceci mais sans grand succès :
Dim NouveauDossierAvecSousDossiers As String
Nom = Range(J5).Value
NouveauDossierAvecSousDossiers = "C:\Users\user\OneDrive -P\" & Nom"\""
Je vous remercie d'avance de l'attention que vous porterez à mon message et je vous souhaite une bonne fin de journée,
Bonjour CiolT,
merci pour votre retour, je suis content que mon site vous est utile.
Pour votre question, essayez ceci:
Il serait aussi utile d'ajouter une vérification si la cellule n'est pas vide pour éviter que cela crashe au cas où J5 est vide:
Pour info,
J5
doit être entre guillemets pour signifier qu'il s'agit de la cellule J5, sinon (sans guillemets) cela signifie que l'adresse se trouve dans une variable qui a le nom J5. Mais cette variable n'existe pas…J'espère que cela va vous aider. Martin
BONJOUR
Je trouver des difficulté avec mon MAC et surtout le problème de chemin afin de créer un dossier toute en enregistrent un fichier Excel transformer en PDF
MERCI de m'aider avec un exemple avec explication pas par pas
Bonjour,
en effet, toutes les fonctionnalités de VBA pour PC ne sont pas réutilisables sur Mac. Il y a de nombreuses différences, notamment lors de l'utilisation des fichiers/dossiers.
Vous trouverez ce dont vous avez besoin sur le sire de Ron de Bruin dédié au VBA pour Mac:
https://www.macexcel.com/examples/filesandfolders/makefolder/
J'espère que cela va vous aider.
Cordialement, Martin
Bonjour à tous,
Je suis ravi de constater qu'il existe une possibilité de créer des sous-dossiers.
Cependant, je suis plus que débutant en VBA avec Excel.
Ce qui implique : c'est quoi une fonction VBA ? Et comment l'utiliser ?
Dans l'attente de vos retours,
Je vous souhaite une bonne journée.
Bonjour,
J'ai un blocage. En effet, j'ai plusieurs feuilles dans le même classeur, dans chaque feuille j'ai un tableau qui me permet en appuyant sur un bouton de créer une ligne avec un nom de dossier ( ex : M.ELH-1 ) et j'ai un tableau de consolidation pour consolider toutes les lignes des tableaux de toutes les feuilles. Il m'a été demandé de créer pour chaque ligne un dossier sur un espace partagé avec 3 sous dossiers ( Technique, Sécurité, Administratif ), la difficulté c'est que moi je veux que le dossier soit crée en même temps que la ligne quand j'appuie sur le bouton et que ce dossier là porte le même nom que la colonne de cette ligne ( ex : M.ELH-1 ) . En plus, mais c'est une option que je pense rajouter, qui est dès que je supprime la ligne du tableau il faut que le dossier aussi soit supprimer ! J'ai essayé plusieurs VBA mais sans succès , si qlq pourrait m'aider SVP .