Soyez le premier à donner votre avis sur cette source.
Snippet vu 7 313 fois - Téléchargée 43 fois
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
31 déc. 2002 à 13:26
30 déc. 2002 à 13:43
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++
30 déc. 2002 à 12:56
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.