programme pour arborescence type

Bonjour,

je souhaiterais creer un programme qui permettrait de choisir un emplacement de dossier via une liste déroulante et creer une arborescence type à partir de cet emplacement.

Merci de votre aide.

Bonjour
Je ne suis pas sur qu'on puisse utiliser des listes déroulantes avec un script:roll:

Salut, il y a un excellent tutoriel HTA réalisé par bbil :
Donner une interface à vos script VBS , HTA

:salut:
un petit startup peut-être ;)
Arboréscence + Taille Dossier dans un fichier HTML

:salut: à tester chez vous, et si vous aimez, alors il faut me payer cash en :plusser: :mouarf:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Titre = "Création de l'Arborescence des Dossiers"
CheminDossier = inputbox ("Entrer le chemin de l'Arborescence des Dossiers pour la création : " , _
	"Création de l'Arborescence des Dossiers" , "C:\1\2\3\4\5\6\7\8\9\10\")
If CheminDossier = "" Then
    Cleanup
    else
         IF Right(CheminDossier, 1) <> "\" Then
         CheminDossier = CheminDossier & "\"
         Arborecence(CheminDossier)
         MsgBox "L'Arborescence :"&vbcr& qq(CheminDossier) &vbcr&_
          " a été crée avec succés !",64,Titre 
         Call Explorer(CheminDossier)
         else
         Arborecence(CheminDossier)
         MsgBox "L'Arborescence :"&vbcr& qq(CheminDossier) &vbcr&_
          " a été crée avec succés !",64,Titre 
         Call Explorer(CheminDossier)
         end if
end if
 
Sub Arborecence(Dossier)   
Dim oFSO:Set oFSO = CreateObject("Scripting.FileSystemObject")
           If oFSO.FolderExists(Dossier) Then 
                  Exit Sub  
           Else    
           Arborecence(oFSO.GetParentFolderName(Dossier)) 
           End If     
           oFSO.CreateFolder(Dossier)  
           Set oFSO = Nothing
End Sub
 
Sub Cleanup
  WScript.Quit
End Sub
 
Function qq(strIn)
    qq = Chr(34) & strIn & Chr(34)
End Function
 
Sub Explorer(Dossier)
Set Ws = CreateObject("wscript.shell")
ws.Run "Explorer "& Dossier,1,True
End Sub