Creation de l'arborescence d'un nouveau répertoire

Contenu du snippet

voir le titre

Source / Exemple :


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

Conclusion :


Pas de commentaire, désolé !

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.