Creation de repertoire et sous repertoire en VBA

Bonjour,

J'arrive a partir de vba a créer des répertoires, mais impossible de créer des sous répertoires voici mon code

Function RépertoireExiste(chemin As String) As Boolean
  Dim fournisseur As Variant
  Dim celluletrouvee As Range
  Dim plage As Range
  Dim NBlignes As Integer
 

NBlignes = Range("B2").CurrentRegion.Rows.Count - 1
Set plage = Range(Cells(1, 2), Cells(NBlignes + 1, 2))
plage.Select
   
    On Error Resume Next
    chemin = "C\Document$\Personnel\edward\Documents\edward document travail\"
    RépertoireExiste = GetAttr("chemin") And vbDirectory
    For Each fournisseur In plage
    fournisseur = celluletrouvee.FormulaR1C1
    Set plage = plage.Find(fournisseur, LookAt:=xlWhole)
            If RépertoireExiste = True Then
            Exit Function
        Else
            MkDir ("\\iut1-srv-fic\Document$\Personnel\edward\Documents\edward document travail\") & fournisseur
                End If
                Next fournisseur
        End Function
   
    Sub tester()
    Call RépertoireExiste("chemin")
    End Sub
    

    

merci de votre aide