Création de dossiers imbriqués en VBA
Lors de votre utilisation d’Access (ou d’Excel d’ailleurs), vous aurez sans doute besoin de créer des dossiers sur votre disque dur. Vous connaissez la commande
MkDirqui crée un dossier à partir d’un chemin. Par contre, cette commande ne va pas jusqu’à créer des sous-dossiers imbriqués. Dans cet article, nous allons régler ce problème…
Le principe
La commande MkDir crée un sous-dossier unique dans un dossier existant. Par exemple :
|
1 |
MkDir "C:\Users\Hervé\Desktop\Test" |
… crée un dossier Test sur mon bureau.
Mais l’instruction a deux inconvénients :
- Elle ne vérifie pas si le sous-dossier existe déjà. Si le dossier
Testde l’exemple existe sur mon bureau, une erreur se produit. - Elle ne crée pas de dossiers imbriqués à partir d’un chemin complet. Concrètement, si je n’ai pas de dossier
Test 1sur mon bureau, ceci échoue :
|
1 |
MkDir "C:\Users\Hervé\Desktop\Test 1\Test 2\Test 3" |
Deux petites procédures
Voici 2 petites procédures pour régler ces petits défauts (à recopier dans un module standard de votre base de données Access ou de votre classeur Excel) :
|
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 |
' --- ' CREATION D'UN DOSSIER ' --- ' Sub CreateFolder(ByVal strDossier As String) If Dir(strDossier, vbDirectory) = "" Then MkDir strDossier End If End Sub ' --- ' CREATION D'UNE ARBORESCENCE DE DOSSIERS ' --- ' Sub CreateFolders(ByVal strPath As String) Dim varFolders As Variant Dim varFolder As Variant Dim strTemp As String On Error GoTo CreateFoldersErr varFolders = Split(strPath, "") strTemp = "" For Each varFolder In varFolders If varFolder <> "" Then If strTemp <> "" Then strTemp = strTemp & "" strTemp = strTemp & varFolder CreateFolder strTemp End If Next Exit Sub CreateFoldersErr: MsgBox Err.Description, vbExclamation Exit Sub End Sub |
La procédure CreateFolder
Pas vraiment complexe, la procédure CreateFolder crée un dossier (unique) en appelant MkDir, mais elle vérifie en plus si le dossier existe déjà. Vous l’appelez comme MkDir, mais vous évitez le test, c’est déjà ça de pris ! 🙂
|
1 |
CreateFolder "C:\Users\Hervé\Desktop\Test" |
La procédure CreateFolders
La procédure CreateFolders (avec un « s ») est plus intéressante : vous lui passez un chemin complet, et elle crée l’ensemble des sous-dossiers nécessaires, lorsqu’ils n’existent pas. Vous pouvez l’utiliser de cette manière :
|
1 |
CreateFolders "C:\Users\Hervé\Desktop\Test 1\Test 2\Test 3" |
Un exemple concret : si vous avez besoin de créer des dossiers datés (année/mois), vous pouvez faire :
|
1 2 3 4 5 6 |
Sub CreerDossiersArchivage() Dim strChemin As String strChemin = "C:\Users\Hervé\Documents\Archive" & Format(Date(), "yyyy\mm") CreateFolders strChemin End Sub |
Merci beaucoup pour l’article. Très utile.
Je m’en suis servi pour mon projet, sans oublié de citer mes sources 🙂
Merci ! 🙂
Et bon développement !
Bonjour,
Super site, bravo et marci.
Pour les joueurs, la même chose en récursif :
Sub CreeRep(Chem)
Dim Pos As Integer
Pos = InStrRev(Chem, « »)
If (Pos > 3) Then CreeRep (Left(Chem, Pos – 1))
If dir(Chem, vbDirectory) = « » Then mkdir Chem
End Sub
CreeRep « C:\Users\Hervé\Desktop\Test 1\Test 2\Test 3 »