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
|
Option Explicit
'Déclarations permettant l'utilisation de variables globales (User logged)
Dim WshShell
Dim WshSysEnv
Set WshShell = CreateObject("WScript.Shell")
Set WshSysEnv = WshShell.Environment("PROCESS")
'Déclaration pour l'utilisation des fichiers
Dim objFSO
Set objFSO = Wscript.CreateObject("Scripting.FileSystemObject")
'Déclarations pour utiliser la boite de dialogue d'utilisation d'un dossier
Const RETURNONLYFSDIRS = &H1
Const NONEWFOLDERBUTTON = &H200
Dim oShell
Dim oFolder, oFolderItem
Set oShell = CreateObject("Shell.Application")
'Variables pour le setup
Dim DossierInstall
Dim DossierCible, DossierBackup, sbFold
Dim File
Dim WS, strDesktop, oMyShortCut, strMyDocuments
Dim Prg, Prg1, myFolder
DossierInstall = "R:\Qualite\Qualite project\ITP Application\ITP-INSTALL"
DossierCible = WshSysEnv("USERPROFILE") & "\Mes documents\ITP APPLICATION"
DossierBackup = WshSysEnv("USERPROFILE") & "\Mes documents\ITP APPLICATION - BACKUP"
MsgBox WshShell.SpecialFolders("MyDocuments"), vbInformation
'1° Teste si le répertoire source existe.
If objFSO.FolderExists(DossierInstall) = False Then
Set oFolder = oShell.BrowseForFolder(&H0&, "Choisir un répertoire", RETURNONLYFSDIRS + NONEWFOLDERBUTTON)
If oFolder Is Nothing Then
MsgBox "Abandon opérateur", vbCritical
Wscript.Quit
Else
Set oFolderItem = oFolder.Self
DossierInstall = oFolderItem.Path
End If
Set oFolderItem = Nothing
Set oFolder = Nothing
Set oShell = Nothing
End If
'On fait une installation que si on a quelque chose !!!!
If objFSO.FolderExists(DossierInstall) Then
'2° Si il y a déjà un BACKUP => suppression
If objFSO.FolderExists(DossierBackup) Then
'MsgBox "dossier backup existant, suppression du Backup", vbInformation
Set myFolder = objFSO.GetFolder(DossierBackup)
'Suppression des fichiers dans le dossier principal
For Each File In myFolder.Files
'On verifie qu'ils ne sont pas en lecture seule
If File.Attributes And 1 Then File.Attributes = File.Attributes - 1
File.Delete()
Next
'suppression des sous dossiers et des fichiers qu'il contient
For Each sbFold In myFolder.SubFolders
For Each File In sbFold.Files
'On verifie qu'ils ne sont pas en lecture seule
If File.Attributes And 1 Then File.Attributes = File.Attributes - 1
File.Delete()
Next
Next
'Suppression du dossier principal
objFSO.DeleteFolder (DossierBackup)
End If
'3° Si une version a déjà été installée, on en fait un BACKUP (pour pouvoir récupérer la base ou des fichiers exemples ...)
If objFSO.FolderExists(DossierCible) Then
'MsgBox "dossier cible existant, Création d'un Backup", vbInformation
Set myFolder = objFSO.GetFolder(DossierCible)
myFolder.Name = "ITP APPLICATION - BACKUP"
End If
'4° On créé le répertoire de destination
'MsgBox "Création du dossier cible", vbInformation
objFSO.CreateFolder (DossierCible)
'3° Créer ou copier directement le dossier ITP-Application
'MsgBox "Copie des fichiers", vbInformation
objFSO.CopyFolder DossierInstall, DossierCible
'4° Créer un raccourcis vers le bureau
MsgBox "Création des raccourcis bureau", vbInformation
MsgBox DossierCible, vbInformation
Prg = WshSysEnv("USERPROFILE") & "\Mes documents\ITP APPLICATION\ITP-EXCEL.xlsm"
Prg1 = WshSysEnv("USERPROFILE") & "\Mes documents\ITP APPLICATION\ITP-EXCEL.xlsm"
myFolder = WshShell.SpecialFolders("DeskTop")
On Error Resume Next
If Err Then MsgBox Err.Description
strDesktop = myFolder
Prg1 = Left(Prg1, InStrRev(Prg1, "\"))
Prg = Right(Prg, Len(Prg) - InStrRev(Prg, "\"))
Set oMyShortCut = WshShell.CreateShortcut(strDesktop & "\" & Prg & ".lnk")
oMyShortCut.TargetPath = WshSysEnv("USERPROFILE") & "\Mes documents\ITP APPLICATION\ITP-EXCEL.xlsm"
'oMyShortCut.Hotkey = "ALT+CTRL+" & Ucase(Left(prg,1))
oMyShortCut.WorkingDirectory = Prg1
oMyShortCut.Save
'5° Créer un raccourcis pour access ????
MsgBox "L'application a été installée avec succès", vbInformation
' ######## Nettoyage de l'environnement ########
Set WshShell = Nothing
Set objFSO = Nothing
End If
Wscript.Quit |
Partager