Creation de l'arborescence d'un nouveau dossier avec ou sans fichier

Contenu du snippet

Créer un ou plusieurs dossiers teste l'existence du ou des dossier avant de
le(s) créer ?
L'argument peut-etre passer avec le nom du fichier à copier.

Source / Exemple :


Public Sub CREER_DOSSIER(ArboDossier As String)
'-Créer un ou plusieurs dossiers teste l'existence du dossier avant de le créer
'-L'argument peut-etre passer avec le nom du fichier
'-Cette procédure permet de créer le chemin complet donné en paramètre.
'-Créer le 05/2002
  On Error Resume Next
'-Déclaration
  Dim lgWhile As Long
  Dim PosPoint As Long '-Position du point
  
'-Traitement pour ajout du slash
'-Test: si la chaîne est passer avec le nom du fichier ou simplement le
'chemin du ou des dossiers à créer
'-Recherche le point de l'extension du fichier
  PosPoint = InStr(ArboDossier, ".")
  
  If PosPoint = 0 Then
     If Right(ArboDossier, 1) <> "\" Then ArboDossier = ArboDossier & "\"
  End If

'-Repère le départ du premier répertoire après la lettre du lecteur.
  lgWhile = InStr(4, ArboDossier, "\")
  
Do While (lgWhile > 0)
'-Vérifie l'existence du répertoire.
    If Dir$(Left$(ArboDossier, lgWhile), vbDirectory) = vbNullString Then
        '-Crée le répertoire.
          MkDir Left$(ArboDossier, lgWhile)
    End If
    lgWhile = InStr(lgWhile + 1, ArboDossier, "\")
Loop
End Sub

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.