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
|
Private Sub Command1_Click()
Set fso = CreateObject("Scripting.FileSystemObject")
Set net = CreateObject("Wscript.Network")
' Set WSHShell = WScript.CreateObject("WScript.Shell")
Set WSHShell = CreateObject("WScript.Shell")
If fso.FileExists("C:\Documents and Settings\" & net.username & "\STC.mdb") Then
MsgBox "STC est déjà présent sur votre ordinateur", vbExclamation, "Installation de la base de données"
Else
If MsgBox("Voulez-vous installer la base de données sur votre Poste ?", vbQuestion + vbYesNo, "Installation de la base de données") = vbYes Then
If fso.FileExists("I:\_All_Sites\Frontale\STC.mdb") Then
fso.CopyFile "I:\_All_Sites\Frontale\STC.mdb", "C:\Documents and Settings\" & net.username & "\STC.mdb"
Else
MsgBox "Problème de connexion au serveur", vbCritical, "Installation de la base de données"
End If
If fso.FileExists("I:\_All_Sites\Frontale\STC.mdw") Then
fso.CopyFile "I:\_All_Sites\Frontale\STC.mdw", "C:\Documents and Settings\" & net.username & "\STC.mdw"
Else
MsgBox "Problème de connexion au serveur", vbCritical, "Installation de la base de données"
End If
If fso.FileExists("I:\_All_Sites\Frontale\STC.ico") Then
fso.CopyFile "I:\_All_Sites\Frontale\STC.ico", "C:\Documents and Settings\" & net.username & "\STC.ico"
Else
MsgBox "Problème de connexion au serveur", vbCritical, "Installation de la base de données"
End If
If fso.FileExists("C:\Documents and Settings\" & net.username & "\STC.ico") Then
'Set net = CreateObject("Wscript.Network") ' répétition ?
'Set WSHShell = CreateObject("WScript.Shell") ' répétition ?
DesktopPath = WSHShell.SpecialFolders("Desktop")
Set Shortcut = WSHShell.CreateShortcut(DesktopPath & "\STC.lnk")
With Shortcut
.TargetPath = WSHShell.ExpandEnvironmentStrings("C:\Program Files\Microsoft Office\Office10\MSACCESS.EXE")
.Arguments = ("""C:\Documents and Settings\" & net.username & "\STC.mdb""" & " " & "/WRKGRP" & " " & """C:\Documents and Settings\" & net.username & "\STC.mdw""")
.WorkingDirectory = WSHShell.ExpandEnvironmentStrings("C:\Documents and Settings\" & net.username & "\")
.IconLocation = WSHShell.ExpandEnvironmentStrings("C:\Documents and Settings\" & net.username & "\STC.ico, 0")
.Description = "Démarre la base de données STC"
'.HotKey = "Aucun"
.WindowStyle = 4
End With
Shortcut.Save
'Else ' ne sert à rien !
End If
MsgBox "En cours de progression, veuillez patienter...", vbInformation, "Installation de la base de données"
MsgBox "Installation terminée ! Pour ouvrir la base de données, cliquer sur le raccourci bureau nommé STC ", vbInformation, "Information STC (Support Technique de Capitalisation)"
Else
MsgBox "Installation annulé", vbExclamation, "Installation de la base de données"
End If
End If
End Sub |
Partager