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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
| <HTML>
<HEAD>
<HTA:APPLICATION INNERBORDER="no" SCROLL="no" ID="Structurerep"
BORDER="thin"
BORDERSTYLE="complex"/>
<TITLE>HTA - Création structure de projets</TITLE>
</HEAD>
<STYLE type="text/css">
body
{
font-family:"Verdana";
font-size:16px;
background-color:#d0e4fe;
}
h1
{
font-family:"Verdana";
font-size:16px;
}
p
{font-family:"Verdana";
font-size:16px;}
fieldset {
padding : 5px;
}
</STYLE>
<BODY>
<H2>HTA - Création structure de projets</H2>
<div width="" id="divFile">
Emplacement : <input type="Text" size="50" name="repchemin" id="repchemin" value="" /> <input type="submit" value="Parcourir" size="50" onclick="parcourir()" />
</div>
<FORM name="form2">
<input type="checkbox" name="chemin" value="gestionproj">01 - Gestion de Projet<br>
<input type="checkbox" name="chemin" value="dlt">02 - DLT<br>
<input type="checkbox" name="chemin" value="photos">03 - Photos<br>
<input type="checkbox" name="chemin" value="technique">04 - Technique<br>
<input type="checkbox" name="chemin" value="mes">05 - MES<br>
<input type="checkbox" name="chemin" value="documentation">06 - Documentation<br>
<br>
<input type="button" value="Valider" onclick="CreerRep()">
</FORM>
<script language="vbscript">
Option Explicit
Const RETURNONLYFSDIRS = &H1
Dim oShell, oFolder, oFolderItem
'==================================================================================================================================================================================
Function parcourir()
Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.BrowseForFolder(&H0&, "Choisir un répertoire", RETURNONLYFSDIRS, "")
If oFolder is Nothing Then
MsgBox "Abandon opérateur",vbCritical
Else
Set oFolderItem = oFolder.Self
'oFolderItem.path
'MsgBox oFolderItem.path
repchemin.Value = oFolderItem.path
End If
Set oFolderItem = Nothing
Set oFolder = Nothing
Set oShell = Nothing
End Function
'==================================================================================================================================================================================
' Fonction de test pour pouvoir créer au moins un répertoire
Function TestCheckBox()
Dim T,CHK
For T = 0 To form2.chemin.length - 1
If form2.chemin(T).checked Then
TestCheckBox = True
Exit For
End If
Next
End Function
'==================================================================================================================================================================================
'==================================================================================================================================================================================
Sub CreerRep()
Dim oFld , i, oFso
If repchemin.Value ="" Then
Msgbox "Vous devez d'abord remplir le champ Emplacement",vbCritical
Exit Sub
End If
If TestCheckBox Then
Set oFSO = CreateObject("Scripting.FileSystemObject")
' Crée le repertoire
For i = 0 To form2.chemin.length - 1
if form2.chemin(0).checked Then
oFSO.CopyFolder "sourceDir\01-Gestion De Projets", repchemin.value & "\01-Gestion De Projets" ,True ' True : pour copier en "écrasant" destination si existe..
End If
if form2.chemin(1).checked Then
oFSO.CopyFolder "sourceDir\02-Gestion DLT",repchemin.value & "\02-Gestion DLT",True ' True : pour copier en "écrasant" destination si existe..
End If
if form2.chemin(2).checked Then
oFSO.CopyFolder "sourceDir\03-Photos",repchemin.value & "\03-Photos",True ' True : pour copier en "écrasant" destination si existe..
End If
if form2.chemin(3).checked Then
oFSO.CopyFolder "sourceDir\04-Technique",repchemin.value & "\04-Technique",True ' True : pour copier en "écrasant" destination si existe..
End If
if form2.chemin(4).checked Then
oFSO.CopyFolder "sourceDir\05-MES",repchemin.value & "\05-MES",True ' True : pour copier en "écrasant" destination si existe..
End If
if form2.chemin(5).checked Then
oFSO.CopyFolder "sourceDir\06-Documentation ",repchemin.value & "\06-Documentation",True ' True : pour copier en "écrasant" destination si existe..
End If
Next
Else : MsgBox "Aucun choix n'a été entré, Veuillez en choisir au moins un"
End If
Set oFld = Nothing
Set oFso = Nothing
End Sub
'==================================================================================================================================================================================
</script>
<fieldset>
<legend><b>Astuce</b></legend>
- Le bouton parcourir vous permet de choisir dans quel dossier l'arborescence sera ajouté.
<br>
- Après avoir crée et choisis votre dossier vous pouvez ajouter les dossiers de votre choix en checkant ceux dont vous avez besoin.
</fieldset>
<script language="Javascript">
window.resizeTo(600, 512);
</script>
</BODY>
</HTML> |
