CREATION DE L'ARBORESCENCE D'UN NOUVEAU RÉPERTOIRE

Public Function RepertoireCreation(ByVal RptChm As String) As Boolean
'
Dim RptTbl() As String
Dim Niveau   As Integer
Dim Trouve   As Boolean
Dim TmpTbl() As String
Dim TmpAtr   As Integer
'
  On Error Resume Next
  RptTbl = Split(RptChm, "\")
  
  Trouve = False
  Niveau = UBound(RptTbl)
  While ((Niveau >= 0) And (Not Trouve))
    
    TmpTbl = RptTbl
    ReDim Preserve TmpTbl(0 To Niveau)
    RptChm = Join(TmpTbl, "\")
    
    Err.Clear
    TmpAtr = GetAttr(RptChm)
    If (Err.Number = 0) Then
      If ((TmpAtr And vbDirectory) = vbDirectory) Then
        Trouve = True
      Else
        Niveau = 0
      End If
    End If
    
    If (Not Trouve) Then
      Niveau = Niveau - 1
    End If
    
  Wend
  
  If ((Trouve) And (Niveau < UBound(RptTbl))) Then
  
    While ((Niveau < UBound(RptTbl)) And (Trouve))
      
      Niveau = Niveau + 1
      TmpTbl = RptTbl
      ReDim Preserve TmpTbl(0 To Niveau)
      RptChm = Join(TmpTbl, "\")
      
      MkDir RptChm
      
      Trouve = (Err.Number = 0)
      
    Wend
  
  End If

  RepertoireCreation = Trouve

End Function