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

Soyez le premier à donner votre avis sur cette source.

Snippet vu 6 841 fois - Téléchargée 39 fois

Commenter

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

Signaler Commenter la réponse de matrey
matrey
Messages postés
399
Date d'inscription
jeudi 31 janvier 2002
Statut
Membre
Dernière intervention
6 septembre 2004
 -
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
Signaler Commenter la réponse de cs_BFR
cs_BFR
Messages postés
88
Date d'inscription
mardi 30 juillet 2002
Statut
Membre
Dernière intervention
1 mars 2008
 -
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++
Signaler Commenter la réponse de SimonKari
SimonKari
Messages postés
80
Date d'inscription
dimanche 29 décembre 2002
Statut
Membre
Dernière intervention
1 octobre 2004
 -
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 !?
Commenter la réponse de matrey
S'inscrire maintenant

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.

Du même auteur (cs_BFR)