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
| <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;}
</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()"> <!-- On remplace submit par button --!>
</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
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(i).checked Then
If Not oFSO.FolderExists(repchemin.Value & "\" & form2.chemin(i).Value) Then
Set oFld=oFSO.CreateFolder(repchemin.Value & "\" & form2.chemin(i).Value)
End If
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>
<p>Statut</p>
<script language="Javascript">
window.resizeTo(600, 512);
</script>
</BODY>
</HTML> |
Partager