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

Soyez le premier à donner votre avis sur cette source.

Snippet vu 7 313 fois - Téléchargée 43 fois

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

Ajouter un commentaire Commentaires
SimonKari Messages postés 80 Date d'inscription dimanche 29 décembre 2002 Statut Membre Dernière intervention 1 octobre 2004
31 déc. 2002 à 13:26
Suis-je le seul à m'être rendu compte que ce code contient un énorme BUG ? De nos jours un répertoire peut contenir un "." donc si tu cherche la première occurence d'un point tu tomberas pas automatiquement sur le point d'extension du fichier !?
cs_BFR Messages postés 88 Date d'inscription mardi 30 juillet 2002 Statut Membre Dernière intervention 1 mars 2008
30 déc. 2002 à 13:43
tous à fait , je connaissais l'autre fonction mais celle-ci te permet de passer en argumet le chemin du ou des dossiers et le fichier pour par EX:copier un fichier dans un dossier
Ces une autre façon de voir les choses ne pas oublier que la programmation est une affaire de "Vision" et que tous les chemin mène à "ROME"
A++
matrey Messages postés 399 Date d'inscription jeudi 31 janvier 2002 Statut Membre Dernière intervention 6 septembre 2004
30 déc. 2002 à 12:56
Mouais... C'est exactement sur quoi je planchais.
J'ai "mieux" :
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal Rep As String) As Long

Private Sub Command1_Click()
Dim Repertoire As String
Dim RetVal As Long
'
Repertoire = "C:TestRep1Rep2Rep3"
RetVal = MakeSureDirectoryPathExists(Repertoire)
If RetVal = 0 Then MsgBox "Erreur"
End Sub

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.