EXCEL : MakeDirP :: Le mkdir -p de linux reconduit en VBA pour la création d'une arborescence de dossier et sous-dossiers

[oguruma]

Bonjour Le Forum,
S'il y a des Linuxiens sur forum, vous connaissez et vous avez certainement utilisé le mkdir -p de Linux. Le voici donc façon VBA afin de créer une arborescence de dossiers et sous-dossiers.
PS : il y a encore peut-être plus rapide ? je suis preneur mais en tout cas ça fait le le boulot. Cette fonction est utilisée dans la version LIBMAC 3.3 publiée hier et disponible.

Exemple d'utilisation

Sub Test_MakeDirP()
    MakeDirP "D:\TEST\DOSSIER\SOUS_DOSSIER\SOUS_SOUS_DOSSIER"
End Sub

Résultat

Le code

Function MakeDirP(hPath As String) As Boolean
    Dim oFSO As Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")

    '------------------------------------------------------
    ' Possible que ce soit un fichier donc hors sujet
    '------------------------------------------------------
    If oFSO.FileExists(hPath) Then
        MakeDirP = False
        Exit Function
    End If

    '------------------------------------------------------
    ' Le dossier existe déjà donc inutile de le créer
    '------------------------------------------------------
    If oFSO.FolderExists(hPath) Then
        MakeDirP = True
        Exit Function
    End If

    '------------------------------------------------------------------------------------------------------
    ' On part en profondeur dans l'arborescence pour créer les dossiers en utilisant la récursivité
    '------------------------------------------------------------------------------------------------------
    If MakeDirP(oFSO.GetParentFolderName(hPath)) Then
        ' si la création échoue
        If oFSO.CreateFolder(hPath) Is Nothing Then
            MakeDirP = False
        Else
            ' Création réussie
            MakeDirP = True
        End If
    Else
        MakeDirP = False
    End If
    
End Function

 

[mromain]

Bonjour oguruma, le forum,

Ci-dessous une autre solution :

Sub MakeDirP(hPath As String)
    Shell "cmd /c mkdir """ & hPath & """"
End Sub

A+

 

[oguruma]

Bonjour oguruma, le forum,

Ci-dessous une autre solution :

Sub MakeDirP(hPath As String)
    Shell "cmd /c mkdir """ & hPath & """"
End Sub

A+

Bonjour MRomain, merci. En effet. Mais je préfère éviter de solliciter l'OS par l'instruction Shell car la gestion du code retour est assez limitée. Après chacun son style. 😉

 

[patricktoulon]

Bonjour @oguruma
le fso est un peu lourdaud qand même
je rejoins mromain sur ce coup la
l'avantage c'est que ca n'écrase pas si une ou la totalité de l'arborescence existe ca ne crée que les non exsitants
on a donc pas de test d'existence a faire et bye bye FSO

Sub testCreateOrAdd()
    Dim Chemin_Pc$
    Chemin_Pc = Environ("userprofile") & "\Desktop\A\B\C\D\E\F\G\H\I\J\K"
    CreateOrAddSubFolder Chemin_Pc
End Sub

Function CreateOrAddSubFolder(Chemin_Pc$)
    If Dir(Chemin_Pc, vbDirectory) = "" Then    ' = si dir_export N'existe pas alors
        With CreateObject("Wscript.Shell")
            .Run "cmd /c mkdir " & Chr(34) & Chemin_Pc & Chr(34)
        End With
    End If
End Function

si je puis me permettre

Icône de la ressource

deux fonctions folder qui simplifie la vie

9 Avril 2023

créer ou supprimer une arbrescence de dossiers complete en un seul coup

• patricktoulon
• arborexcence création delete folder with subfolder dossier folder fonction sub folder
• VBA

 

[oguruma]

Bonjour @oguruma
le fso est un peu lourdaud qand même
je rejoins mromain sur ce coup la
l'avantage c'est que ca n'écrase pas si une ou la totalité de l'arborescence existe ca ne crée que les non exsitants
on a donc pas de test d'existence a faire et bye bye FSO

Sub testCreateOrAdd()
    Dim Chemin_Pc$
    Chemin_Pc = Environ("userprofile") & "\Desktop\A\B\C\D\E\F\G\H\I\J\K"
    CreateOrAddSubFolder Chemin_Pc
End Sub

Function CreateOrAddSubFolder(Chemin_Pc$)
    If Dir(Chemin_Pc, vbDirectory) = "" Then    ' = si dir_export N'existe pas alors
        With CreateObject("Wscript.Shell")
            .Run "cmd /c mkdir " & Chr(34) & Chemin_Pc & Chr(34)
        End With
    End If
End Function

si je puis me permettre

Icône de la ressource

deux fonctions folder qui simplifie la vie

9 Avril 2023

créer ou supprimer une arbrescence de dossiers complete en un seul coup

• patricktoulon
• arborexcence création delete folder with subfolder dossier folder fonction sub folder
• VBA

bonjour
chacun son chtyle
j'évite personnellement de solliciter l'os par l'extérieur la gestion du code retour est inexistante ou peu fiable.
Cette fonction je l'ai utilisé maintes fois sans aucun problème.
Du reste sous Linux elle fonctionne de la même manière.
Voir sous linux elle est encore plus astucieuse car elle tient compte des "sticky bit" ce qui n'existe pas sous Windows 🙂