Comment créer des dossiers et sous dossiers en VBA

Modèles prêt à l'emploi, Projets Excel-VBA complets

Voir la boutique
Accueil » Tutoriels VBA » Comment créer des dossiers et sous dossiers en VBA

Gagner du temps en laissant votre code VBA créer des dossiers et sous dossiers pour vous. Un classement standard et respecté pourra faire économiser un grand nombre d’aller-retours à votre équipe et vous au quotidien. Aujourd’hui Numamax vous propose 3 méthodes pour composer un système de création de dossiers selon vos besoins.

Pourquoi préférer laisser votre code créer des dossiers et sous dossiers ?

Nous sommes amené à stocker notre travail quotidiennement pour consultation par nos collègues ou sauvegarde. Lorsque la fréquence de création de vos dossiers est régulière il devient intéressant d’utiliser une des trois méthodes ci-dessous afin de “graver” une bonne fois pour toute votre classification et la confier à votre code VBA. De cette façon, les chemins de dossiers ne dépendent plus des méthodes de chaque utilisateur, cette standardisation vous fera gagner temps et qualité de travail.
La standardisation pourra même vous permettre d’automatiser d’autres tâches comme vous saurez exactement comme s’appelleront vos dossiers !

Les Méthodes pour créer des dossiers et sous dossiers en VBA fonctionnant sur Excel Access Word Outlook avec Exemples

Méthode #1 : Fonction VBA MkDir

Méthode #2 : CreateFolder de l’objet Scripting.FileSystemObject

Méthode #3 : Fonction personnalisée "CreerMesDossierSousDossiers"

Difficulté

1/5
1.5/5
3/5

POINTS FORTS

  • Ultra simple, fonction déjà implémentée dans VBA
  • Pas de nouvelle référence de bibliothèque à rajouter
  • Simplicité pour créer en plusieurs lignes des chemins de dossiers et sous dossiers
  • Utilisation de l'objet objet "Scripting.FileSystemObject"
  • Permet de créer directement des sous-dossiers dans des dossiers qui n'existent pas encore
  • Permet une gestion des erreurs personalisées
  • Fonctionne dans des emplacements réseaux

POINTS FAIBLES

  • Impossibilité de créer en une seule fois un sous dossier dans un dossier qui n'existe pas
  • Nécessite de définir la référence à la bibliothèque "Microsoft Scripting Runtime"
  • Nécessite de paramétrer une fonction public avant d'appeler la fonction dans votre code

Sub Exemple1()

MkDir ("C:\Users\Numamax_User\Desktop\Numamax")

End Sub


Sub Exemple2()

'Si vous voulez créer un sous-dossier (ici Numamax) dans un dossier qui n'existe pas (ici DossierQuiExistePas)
'Alors il faut s'y reprendre en plusieurs ligne

MkDir ("C:\Users\Numamax_User\Desktop\DossierQuiExistePas")
MkDir ("C:\Users\Numamax_User\Desktop\DossierQuiExistePas\Numamax")

End Sub



Sub Exemple1()

Dim fs As New Scripting.FileSystemObject 'Ne pas oublier la référence à la bibliothèque "Microsoft Scripting Runtime"?

fs.CreateFolder "C:\Users\Numamax_User\Desktop\Numamax"

Set fs = Nothing 'On vide la mémoire

End Sub



Sub Exemple2()

'Si vous voulez créer un sous-dossier (ici Numamax) dans un dossier qui n'existe pas (ici DossierQuiExistePas)
'Alors il faut s'y reprendre en plusieurs ligne

Dim fs As New Scripting.FileSystemObject 'Ne pas oublier la référence à la bibliothèque "Microsoft Scripting Runtime"?

fs.CreateFolder "C:\Users\Numamax_User\Desktop\DossierQuiExistePas"
fs.CreateFolder "C:\Users\Numamax_User\Desktop\DossierQuiExistePas\Numamax"

Set fs = Nothing 'On vide la mémoire

End Sub



Sub ExempleFonctionCreerMesDossierSousDossiers()
    ' Grace à cette fonction vous pouvez même créer des sous dossiers même si le dossier n'existe pas
    CreerMesDossierSousDossiers ("C:\Users\Numamax_User\Desktop\DossierQuiExistePas\Numamax") 'avec ou sans l'antislash à la fin

End Sub



Public Function CreerMesDossierSousDossiers(Chemin As String) 'Fonction qui prend comme input le chemin de dossier(s) à créer

On Error GoTo CreerMesDossierSousDossiersErreur


Dim MonSeparateurSysteme As String
MonSeparateurSysteme = "\" 'l'antislash, on évite l'appel à "Application.PathSeparator" qui ne fonctionne qu'avec l'application Excel



Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")


If fs.FolderExists(Chemin) = False Then 'On teste si le chemin n'existe pas déjà, sinon il n'y a pas besoin de le créer et on s'évite une erreur

'MsgBox "le chemin n'existe pas"

    If Right(Chemin, 1) = "\" Then Chemin = Left(Chemin, Len(Chemin) - 1) 'Pour s'éviter une autre erreur, on retire le backslash final si présent
    

    If Left(Chemin, 2) = "\\" Then 'vérificacion si chemin local ou réseau
        CheminReseau = True
    Else
        CheminReseau = False
    End If
    
        

    If CheminReseau = False Then 'On décompose le chemin
        PartiesDeChemin = Split(Chemin, "\")
        CheminPartielOK = ""
        PremierDossier = LBound(PartiesDeChemin)
    Else
        PartiesDeChemin = Split(Replace(Chemin, "\\", ""), "\")
        CheminPartielOK = ""
        PremierDossier = LBound(PartiesDeChemin) + 1
    End If



    For PartieDeChemin = PremierDossier To UBound(PartiesDeChemin) 'tests et créations de (sous)dossiers

        For CheminPartiel = LBound(PartiesDeChemin) To PartieDeChemin
        
                    If CheminReseau = False Then
                        CheminPartielOK = CheminPartielOK & PartiesDeChemin(CheminPartiel) & "\"
                    Else
                        CheminPartielOK = CheminPartielOK & PartiesDeChemin(CheminPartiel) & "\"
                    End If

            If CheminPartiel = PartieDeChemin Then
                    If CheminReseau = False Then
                                If fs.FolderExists(CheminPartielOK) = False Then
                                        fs.CreateFolder CheminPartielOK
                                End If
                    Else
                                If Right(CheminPartielOK, 1) = "\" Then _
                                CheminPartielOK = Left(CheminPartielOK, Len(CheminPartielOK) - 1)
                                
                                If Left(CheminPartielOK, 2) <> "\\" Then _
                                CheminPartielOK = "\\" & CheminPartielOK
                                
                                If fs.FolderExists(CheminPartielOK) = False Then
                                        fs.CreateFolder CheminPartielOK
                                End If
                    End If
            End If
        Next CheminPartiel
        
        CheminPartielOK = ""
        
    Next PartieDeChemin

Else

    MsgBox "Le chemin rentré existe déjà : rien n'a été fait"
    CreerMesDossierSousDossiers = True
    Set fs = Nothing 'On vide la mémoire
    Exit Function

End If




CreerMesDossierSousDossiers = True 'Réussite de la fonction
MsgBox "Le chemin rentré a bien été créé : " & Chemin
Set fs = Nothing 'On vide la mémoire
Exit Function 'Fin de la fonction

CreerMesDossierSousDossiersErreur:
CreerMesDossierSousDossiers = False 'Echec de la fonction
End Function

CONCLUSION : Comment créer des dossiers et sous dossiers en VBA ?

Après ce comparatif vous pourrez trouver un éventail de solutions de la plus rapide à mettre en place à la plus robuste. Cependant il est important de soulever certains points : 
  • Premièrement une fonction personnalisée (comme celle de cette article) par vos soins et adapter à votre activité sera toujours plus robuste. En effet vous pourrez progressivement adapter la  gestion des erreurs à votre équipe.
  • Enfin, dans le cas où vous partirez sur la fonction personnalisée il est à noter qu’il peut être un peu répétitif de déclarer la fonction dans chaque applicatif où vous l’utilisez (Excel Access Word Outlook).

Source 1

Source 2

Prenez quelques secondes pour

 nous évaluer !, nous encourager avec un don !, partager ce contenu !
[kkratings]
[kkratings]