1. Accueil
  2. Forum Codes-Sources
  3. Visual Basic
  4. Visual Basic 6

Recherche d'un dossier, et création d'un dossier dans ce dosser...

Signaler
Messages postés
90
Date d'inscription
mercredi 21 novembre 2007
Statut
Membre
Dernière intervention
25 mai 2013
 -
Messages postés
90
Date d'inscription
mercredi 21 novembre 2007
Statut
Membre
Dernière intervention
25 mai 2013
 -
Alors voila, je sais que beaucoup de sujets en parlent, de cette fameuse recherche de dossier..
Quand je recherche un dossier directement dans "C:"
J'utilise :

dim fichier, FSO
Set FSO = CreateObject("Scripting.FileSystemObject" )const forreading 1, forwriting 2, forappending = 8
recherche = "fichier à chercher"
ShowSubfolders FSO.GetFolder("C:" ), recherche


Sub ShowSubFolders(Folder, recherche)
For Each Subfolder in Folder.SubFolders
If Subfolder.name = recherche Then
Wscript.Echo Subfolder.name
wscript.quit
Else
ShowSubFolders Subfolder, recherche
End If
Next
End Sub

Pourtant, j'ai beau faire, j'ai toujours une erreur de "permission" quand je cherche un dossier profondément comme dans :
"C:\Fichiers\..."
et que je met comme dossier source "C:"

Quelqu'un pourrait m'aider svp??
Afficher la suite

10 réponses

Réponse 1 / 10
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
 26
 Bonsoir,

Le script proposé est du vbs.
Merci, la prochaine fois, de poster dans le bon thème !
Quant à la permission, il faut outrepasser avec On Error Resume Next .

Option Explicit
Dim objFso, objRootFolder
Dim strRootPath, strSubFolder, strResult
strRootPath = "D:\SCRIPTS"

Set objFso = CreateObject("Scripting.FileSystemObject")
Set objRootFolder = objFso.GetFolder(strRootPath)

Call SearchFolders(objRootFolder)
Msgbox strResult,,"Enumératon Sous-Répertoire(s) de " & strRootPath

Set objRootFolder = Nothing
Set objFso = Nothing

Sub SearchFolders(ArgFolder)
For Each strSubFolder In ArgFolder.SubFolders
On Error Resume Next  ' permission
Call SelectFolder(strSubfolder)
Call SearchFolders(strSubfolder)
Next
End Sub

Sub SelectFolder(ArgFolder)
strResult = strResult &vbCrLf& ArgFolder
End Sub

jean-marc
Réponse 2 / 10
Messages postés
90
Date d'inscription
mercredi 21 novembre 2007
Statut
Membre
Dernière intervention
25 mai 2013
Mince ! comme cet la premiere fois que je demande quelque chose, je savais pas
exactement comment faire... J'ai cherché mais j'ai pas trouvé le thème"vbs"
Bref, la commande on error resume next permet de continuer la recherche?

Parce que à chaque fois que je cherchais un dossier qui n'était pas directement dans "C:" mais
dans un dossier de "C:" j'avais une erreur...

Dans le code, ou est stipulé le nom du dossier a chercher?
Réponse 3 / 10
Messages postés
90
Date d'inscription
mercredi 21 novembre 2007
Statut
Membre
Dernière intervention
25 mai 2013
Ohhhh ! C'est bon j'ai compris !! Merci bcp Jean-Marc! Depuis le temps que je cherchais en vain sur les innombrables débats là dessus ! Merci encore
Réponse 4 / 10
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
 26
Re,

pour le vbs [infomsg.aspx Thèmes]

/ [infomsgf_VISUAL-BASIC_1.aspx Visual Basic 6] / [infomsgt_LANGAGES-DERIVES_287.aspx Langages dérivés] / [infomsgt_VBSCRIPT_245.aspx VBScript]

Ci-dessous, 2 exemples.

1)Vérification de l'existence d'un répertoire:
MsgBox ShowFolderExists("D:\SCRIPTS\Fichiers"),,"Contrôle existence Dossier"
MsgBox ShowFolderExists("D:\SCRIPTS\Fichiers"),,"Contrôle existence Dossier"
MsgBox ShowFolderExists("D:\SCRIPTS\Wichiers"),,"Contrôle existence Dossier"
MsgBox ShowFolderExists("D:\SCRIPTS\Wichiers"),,"Contrôle existence Dossier"

Function ShowFolderExists(strFolder)
Set objFso   = WScript.CreateObject("Scripting.FileSystemObject")
If Right(strFolder,1)="" Then strFolder = Left(strFolder,Len(strFolder)-1)
strFolder = strFolder & ""
If objFso.FolderExists(strFolder) = True Then
    ShowFolderExists = strFolder &vblf& "Le dossier existe"
   Else
   ShowFolderExists = strFolder &vblf& "Le dossier n'existe pas"
end If
Set objFso = Nothing
End Function

2) Création arborescence d'un répertoire:
Const racine = "D:\SCRIPTS\Fichiers"
MsgBox Verif_Folder(racine),,"Vérification du répertoire"

Function Verif_Folder(rac)
Dim objFso
 Set objFso = CreateObject("Scripting.FileSystemObject")
If Not objFso.FolderExists(rac) Then
       'Msgbox "la racine n existe pas"
       Set objFso = Nothing
       Exit Function
   Else
   'MsgBox "la racine existe"
   Dim ext(3), i, f, result
   ext(0) = "Pdr"
   ext(1) = "DC"
   ext(2) = "Qualif"
  
   For i = 0  To UBound(ext)
       result = result & ext(i)
       If Not objFso.FolderExists(rac & result) Then objFso.CreateFolder(rac & result)
   Next
   Verif_Folder = rac & result
End If
Set objFso = Nothing
End Function

jean-marc
Réponse 5 / 10
Messages postés
90
Date d'inscription
mercredi 21 novembre 2007
Statut
Membre
Dernière intervention
25 mai 2013
Merci beaucoup !!! Par contre j'ai encore un pti pb récursif...
J'obtiens une boucle sans fin alors que j'ai stipulé "wscript.exit" :

Sub ShowSubFolders(Folder, recherche)
For Each Subfolder in Folder.SubFolders
On Error Resume Next
If Subfolder.name = recherche Then
Wscript.Echo Subfolder.name
ObjShell.Exec CheminWinRar & " a -r " & chr(34) & Subfolder.path & "" & nomduprojet & ".rar" & chr(34) & " " & chr(34) & RepSource & chr(34)
wscript.exit


Else
ShowSubFolders Subfolder, recherche
End If
Next
End Sub

Tu peux m'aider stp?
Réponse 6 / 10
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
 26
Re,

Pour quitter la boucle et, donc la Sub, il est plus élégant de mettre Exit For
à la place de <strike>WScript.Exit</strike> WScript.Quit(0)

jean-marc
Réponse 7 / 10
Messages postés
90
Date d'inscription
mercredi 21 novembre 2007
Statut
Membre
Dernière intervention
25 mai 2013
Oui ahah, jme suis rendu compte que j'avais été tro vite ...
En tout cas merci pour toutes ces réponses ! Je ne connaissais pas le "exit for"..
Si j'abusais je poserai une dernière question... Car là, je suis encore sur un
"paradoxe".
Je voudrais faire en sorte que quand le dossier recherché à été trouvé,
un dossier (différent) soit supprimé. J'utilise alors le "fso.deletefolder".
Pourtant, dans la procédure sub, ca ne marche pas :

Sub ShowSubFolders(Folder, recherche)


For Each Subfolder in Folder.SubFolders
On Error Resume Next
If Subfolder.name = recherche Then
ObjShell.Exec CheminWinRar & " a -r " & chr(34) & Subfolder.path & "" & nomduprojet & ".rar" & chr(34) & " " & chr(34) & RepSource & chr(34)



suppression = enregistrement & "" & nomduprojet
set fso=createobject("scripting.FileSystemObject")
fso.deletefolder suppression


exit for
Else
ShowSubFolders Subfolder, recherche
End If
Next
End Sub

Alors que dans un programme de suppression de dossier, ca fonctionne !!

dossier = inputbox ("Dossier à supprimer : ","Suppression d'un dossier","C:")



set fso=createobject("scripting.FileSystemObject")
fso.deletefolder dossier
Réponse 8 / 10
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
 26
Re,

suppression = enregistrement & "" & nomduprojet
msgbox suppression,,"suppression"
msgbox enregistrement,,"enregistrement"
msgbox nomduprojet,,"nomdu projet"

jean-marc
Réponse 9 / 10
Messages postés
90
Date d'inscription
mercredi 21 novembre 2007
Statut
Membre
Dernière intervention
25 mai 2013
Quelques questions par ci par là...
Réponse 10 / 10
Messages postés
90
Date d'inscription
mercredi 21 novembre 2007
Statut
Membre
Dernière intervention
25 mai 2013
Mince ca a buggé... Je disais,
j'avoue ne pas comprendre, je suis vraiment vraiment amateur
Les textbox m'affichent les emplacements et les fichiers à supprimer
mais mon dossier n'est toujours pas supprimé
Répondre Posez votre question