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> |
Partager