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