Création Des Dossiers Et Sous-dossiers En VBA | Excel

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?
• Fonction VBA MkDir() pour créer un simple répertoire
• Fonction VBA pour créer des dossiers et des sous-dossiers en même temps
• Exemple pratique d'utilisation de la fonction VBA
• Pour aller plus loin en Excel et en VBA

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.

Nouveau! 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.

MkDir("C:\Test\MonDossier1\")

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…

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

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576

FunctionCreerDossier(Chemin AsString)'par: Excel-Malin.com ( https://excel-malin.com )On ErrorGoToCreerDossierErreur DimPremierDossier AsStringDimCheminReseau AsBooleanDimCheminPartielOK AsStringDimCheminPartiel,PartieDeChemin AsIntegerDimPartiesDeChemin AsVariant DimFSO AsObjectSetFSO=CreateObject("Scripting.FileSystemObject") IfLen(Dir(Chemin,vbDirectory))>0ThenCreerDossier=TrueExitFunctionElse'suppression du dernier backslash si présentIfRight(Chemin,1)=Application.PathSeparator ThenChemin=Left(Chemin,Len(Chemin)-1)'vérificacion si chemin local ou réseauIfLeft(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)+1EndIf'tests et créations de (sous)dossiersForPartieDeChemin=PremierDossier ToUBound(PartiesDeChemin) ForCheminPartiel=LBound(PartiesDeChemin)ToPartieDeCheminIfCheminReseau=FalseThenCheminPartielOK=CheminPartielOK&PartiesDeChemin(CheminPartiel)&Application.PathSeparatorElseCheminPartielOK=CheminPartielOK&PartiesDeChemin(CheminPartiel)&Application.PathSeparatorEndIf IfCheminPartiel=PartieDeChemin ThenIfCheminReseau=FalseThenIfFSO.FolderExists(CheminPartielOK)=FalseThenMkDir CheminPartielOKEndIfElseIfRight(CheminPartielOK,1)=Application.PathSeparator Then_CheminPartielOK=Left(CheminPartielOK,Len(CheminPartielOK)-1)IfLeft(CheminPartielOK,2)<>"\\" Then _ CheminPartielOK = "\\"&CheminPartielOKIfFSO.FolderExists(CheminPartielOK)=FalseThenMkDir CheminPartielOKEndIfEndIfEndIfNextCheminPartielCheminPartielOK=""NextPartieDeCheminEndIf CreerDossier=TrueExitFunctionCreerDossierErreur:CreerDossier=FalseEndFunction

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

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

1234567891011

SubExempleCreationDossierAvecSousdossiers()'par: Excel-Malin.com ( https://excel-malin.com )On ErrorGoToExempleErreur DimNouveauDossierAvecSousDossiers AsStringNouveauDossierAvecSousDossiers="C:\Temp\MonDossier\MonSousDossier\Niveau_3\Niveau_4"'vous pouvez remplacer cette valeur par votre dossier CreerDossier(NouveauDossierAvecSousDossiers)ExitSubExempleErreur:MsgBox"Une erreur est survenue..."EndSub

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"