Script pour copie de PST sur un serveur
Bonjour,
Etant novie en vb, j'ai créé un script qui permet de sauvegarder les PST sur un espace dique d'un serveur à travers un lecteur reseaux.
Pour plus de finalité je souhaiterais me dire ce que vous en pensez et si vous avez des suggestion pour améliorer au mieux le script.
Voici le script:
Code:
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
| '----------------------------------------------------------------------------------------
' **** DECLARATION DES INSTANCES UTILES *****
'----------------------------------------------------------------------------------------
set shell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
'----------------------------------------------------------------------------------------
' **** PARAMETRES DU CLIENT ET DU SERVEUR *****
'----------------------------------------------------------------------------------------
serveur = "adresse IP" ' IP du serveur de backup
dir_source = "emplacement du pst" ' Chemin pour le PST source (local)
dir_copie = "y:\nom du fichier\" ' Chemin vers le serveur (distant)
nom_pst = "outlook.pst" ' Nom du PST à traiter
ext_copie = ".old" ' Extension pour la copie de sauvegarde
if not (objFSO.FileExists(dir_source & nom_pst)) then
' On quitte si PST introuvable
shell.Popup "Fichier source introuvable", 4, "Annulation", 64 + 7
end if
'----------------------------------------------------------------------------------------
' **** VERIFIER QU'ON EST CONNECTE AU RESEAU *****
'----------------------------------------------------------------------------------------
Function IsConnectable(sHost,iPings,iTO)
' sHost is a hostname or IP
' iPings is number of ping attempts
' iTO is timeout in milliseconds
' if values are set to "", then defaults below used
If iPings = "" Then iPings = 2
If iTO = "" Then iTO = 750
Set ExCmd = shell.Exec("ping -n " & iPings & " -w " & iTO & " " & sHost)
Select Case InStr(ExCmd.StdOut.Readall,"perte 0%")
Case 0 IsConnectable = False
Case Else IsConnectable = True
End Select
End Function
if IsConnectable(serveur,"","") = False then
' On quitte si on est hors du réseau interne
msgbox "Vous êtes en déplacement", 1, "Hors Ligne", 64 + 7
WScript.Quit -1
end if
'----------------------------------------------------------------------------------------
' **** POPUP AVERTISSEMENT *****
'----------------------------------------------------------------------------------------
MsgBox "Sauvegarde de vos mails en cours, Outlook sera ouvert automatiquement à la fin de la savegarde. Patienter SVP..."
'----------------------------------------------------------------------------------------
' **** COPIE PST EN BACKUP SUR SERVEUR ****
'----------------------------------------------------------------------------------------
' Supprimer l'ancien .old
if (objFSO.FileExists(dir_copie & nom_pst & ext_copie)) then
objFSO.DeleteFile dir_copie & nom_pst & ext_copie, true
end if
' Renomme l'ancien PST en .old sur le serveur
if (objFSO.FileExists(dir_copie & nom_pst)) then
objFSO.MoveFile dir_copie & nom_pst , dir_copie & nom_pst & ext_copie
end if
' Copie du PST local sur le serveur
'déclaration file system object
Dim fso
'instanciation
Set FSO = CreateObject("Scripting.FileSystemObject")
'Copie du fichier
Set Ftxt = fso.GetFile("C:\Users\gj\AppData\Local\Microsoft\Outlook\outlook.pst") 'Fichier origine
Ftxt.copy("y:\test\") 'emplacement destination
'----------------------------------------------------------------------------------------
' **** OUVRIR OUTLOOK ****
'----------------------------------------------------------------------------------------
'shell.Popup "Ouverture d'Outlook en cours", 2, "Patienter...", 64 + 7
set WshShell = createObject("WScript.shell")
Wshshell.run "Outlook.exe" |
Merci d'avance,
Greg.
