Creer un chemin de plusieurs dossiers

Soyez le premier à donner votre avis sur cette source.

Snippet vu 6 805 fois - Téléchargée 42 fois

Contenu du snippet

Ou comment faire quand MkDir, CreateFolder (api) ou le FSO echoue lors de la création d'un dossier avec ses sous dossiers. exemple : C:\TMP\SOUSTMP\SOUSOUSTEMP\ETPLEINDESOUSOUSDANSLAPOCHE.

Passez le nom du dossier en argument a une fonction a créer plutôt que ce vulgaire bouton.

Source / Exemple :


Private Sub Command1_Click()
  
  On Error Resume Next
  
  Dim sDossACreer   As String
  Dim sTmp          As String
  
  Dim oFso          As New Scripting.FileSystemObject
  'Projet>Ref>Microsoft Scripting Runtime (
  
  sDossACreer = "C:\TEMP\EXT\1\1\2\1\1"
  
 'Création des sous-dossiers
  sTmp = sDossACreer
  While Not oFso.FolderExists(sTmp)
    sTmp = oFso.GetParentFolderName(sTmp)
    oFso.CreateFolder sTmp
    If Err Then Err.Clear Else sTmp = sDossACreer
  Wend
  
  'Création du dernier dossier
  If Not oFso.FolderExists(sDossACreer) Then oFso.CreateFolder sDossACreer
  
End Sub

Conclusion :


Un peu de pub ... Adoupdoupdoupdoup ...
WinMacro, ArchiDoc, MCopy sur http://soy.free.fr

A voir également

Ajouter un commentaire Commentaires
Messages postés
6
Date d'inscription
mercredi 20 mars 2002
Statut
Membre
Dernière intervention
30 mars 2011

Merci Vico, et même bravo pour cette version sans 'on error resume next'. Il y a quand même une nuance c'est que 'split' n'existe pas sous VB5. @+ ;-)
Messages postés
436
Date d'inscription
dimanche 20 janvier 2002
Statut
Membre
Dernière intervention
2 février 2010
2
j'remet le kode...
Private Sub Command1_Click()

Dim sDossACreer() As String, sPath As String
Dim oFso As New Scripting.FileSystemObject
' ----
sDossACreer = Split("C:\TEMP\EXT\1\1\2\1\1", "")
sPath = sDossACreer(0) & ""

For i = 1 To UBound(sDossACreer)
If Not oFso.FolderExists(sPath & sDossACreer(i)) _
Then oFso.CreateFolder sPath & sDossACreer(i)

sPath = sPath & sDossACreer(i) & ""
Next

End Sub

Shop !!
@+
Messages postés
436
Date d'inscription
dimanche 20 janvier 2002
Statut
Membre
Dernière intervention
2 février 2010
2
Bonjour -;)
Pour moi : on error resume next c'est une façon de dire que même si ça marche pa ça marche !! un peu comme les mangeurs de pop korn en ce moment...
Vaudrait mieux écrire ça :

Private Sub Command1_Click()

Dim sDossACreer() As String, sPath As String
Dim oFso As New Scripting.FileSystemObject
' ----
sDossACreer = Split("C:TEMPEXT11211", "")
sPath = sDossACreer(0) & ""

For i = 1 To UBound(sDossACreer)
If Not oFso.FolderExists(sPath & sDossACreer(i)) _
Then oFso.CreateFolder sPath & sDossACreer(i)

sPath = sPath & sDossACreer(i) & ""
Next

End Sub

@+, VIC

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.