Copier contenu Mes Documents Seven

Version imprimable

Bonjour,

J'ai réalisé un script de sauvegarde de Mes Documents qui fonctionne sous Windows XP sans problème.
En revanche, sous Windows 7, ca m'indique une erreur de permission.
Je suppose que c'est à cause du répertoire "Documents publics" mais je n'arrive pas a comprendre comment passer se problème.
Voici mon script de copie :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 sub backup_Doc Set WshShell = CreateObject("WScript.Shell") Mesdoc = WShShell.SpecialFolders("MyDocuments") Dim objFSO, objSourceFolder, objDestinationFolder Set objFSO = CreateObject("Scripting.FileSystemObject") objSourceFolder = Mesdoc objDestinationFolder = MesDocuments Set oFSO = CreateObject("Scripting.FileSystemObject") MesDocuments = Racine & "\" & "Mes documents" set fd=oFSO.getfolder(objSourceFolder) Fd.Copy MesDocuments,true End sub
Merci d'avance.

Edit, c'est bien Mes documents public qui posent un problème car si je change la source par mes documents/un sous répertoire => c'est ok
Si je met en source mes doc public, là j'ai de nouveau le message d'erreur permission refusée.

Du coup comment enlever se répertoire de la sauvegarde :(

04/02/2012, 11h24
hackoofr

:salut:
Dans la ligne N°14 la variable Racine représente quoi :koi:
Pouvez-vous faire un copier coller de votre source en entier et indiquez dans quelle ligne exactement vous avez cette erreur
:merci:
05/02/2012, 19h45
Pasokoniidesuka

On comprend pas trop comment il marche ton script outre l'absence de la variable racine.
Par contre encore une fois on a un script de sauvegarde mais pourquoi ne pas utiliser robocopy ? Réfères toi au dernier paragraphe de ce message :
http://www.developpez.net/forums/d11...e/#post6475889
06/02/2012, 09h38
ponpon17430
Ma variable racine correspond a cela :

Code:

Racine = objPath & "\" & UserEnCours & "\" & "Sauvegarde_données"

Et objPath correspond à un répertoire sélectionné par l'utilisateur depuis une fonction parcourir que je lance au début pour que l'utilisateur puisse choisir l'emplacement de sa sauvegarde.

Je ne peux pas utiliser robocopy car si mon script fonctionne bien, je vais peut être le deployer à mon travail je ne peux pas copier la commande sur tous les pc.

Sinon pour résumer mon script :
Quand on clique sur le .HTA, une fenetre s'ouvre demandant de choisir un emplacement pour la sauvegarde.
Une fois l'emplacement selectionné, je créé mon arborescence comme ceci :
Username/sauvegarde puis 3 autres repertoires PST Bureau Mes documents

Ensuite la fenetre de mon hta s'ouvre ou j'ai 3 choix soit backup mes documents / mon bureau ou juste mon/mes PST

Une fois le choix définit, j'appuie sur un bouton continuer et là je lance ma fonction de backup.

Sous XP aucun problème mais sous windows 7, j'ai un problème de permission avec mes documents et c'est le repertoire mes documents public qui pose problème, il faudrait que je puisse l'exclure mais je n'y arrive pas.

voila voila

Edit : Autrement j'essaie la méthode xcopy mais je n'arrive pas a inclure mes variable :
Code:

1 2 3 4 5 Mesdoc = WShShell.SpecialFolders("MyDocuments") objSourceFolder = Mesdoc MesDocuments = Racine & "\" & "Mes documents" WshShell.run "xcopy /E " & objSourceFolder & "*.*" & MesDocuments
Si je fais un msgbox pour afficher mes variables, elles sont bien correctes.
06/02/2012, 11h51
hackoofr

:salut:
On ne peut pas tester votre code .HTA dans deux environnements différents Win XP et Win 7 ,si vous ne le postiez pas.
Alors pour qu'on puisse avancer un peu et tester votre code avec vous, il faut que vous nous postiez en entier et si vous avez des données personnelles dans ce dernier il vous suffit juste de les remplacer par des étoiles *******
:merci:

Voila le fichier en entier. (désolé si je le code n'est pas super clair)

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
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
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
 
<html>
 
<body>
 
<span style="color:#00000;font-family: Verdana;font-size: 13pt">Bienvenue dans l'utilitaire de sauvegarde de vos données personnelles.</span>
 
<br><br>
Sélectionnez le dossier à sauver :
<br>
<br>
<span style="color:red;font-family: Berlin Sans FB Demi">
/!\ Avant de commencer, Veuillez sauvegarder vos documents et fermer Outlook /!\</span>
<br>
<br>
<input type="checkbox" ID="Doc" name="Doc"> : Sauvegarde de Mes Documents (Tous les fichiers)
<br>
<input type="checkbox" ID="Bur" name="Bur"> : Sauvegarde du Bureau (Tous les fichiers)
<br>
<input type="checkbox" ID="PST" name="PST"> : Sauvegarde UNIQUEMENT le/les PST
 
<script type="text/javascript"> 
function fermer() 
{ 
self.close(); 
}  
</script>
<SCRIPT LANGUAGE="VBScript">
ResizeTo 700,400
 
'==================================================================================================================
'Fenêtre pour choisir repertoire cible de sauvegarde
'==================================================================================================================
Const WINDOW_HANDLE = 0
BIF_editbox = &H0010
titre="Sélectionner la destination de la sauvegarde"
Set objShell = CreateObject("Shell.Application" )
Set objFolder = objShell.BrowseForFolder _
    (WINDOW_HANDLE, titre , BIF_editbox)
On Error Resume Next
Set objFolderItem = objFolder.Self
If Err <> 0 Then
        msgbox "Annulation de la sauvegarde"
		fermer()
Else
        objPath = objFolderItem.Path
		arobrescence
end if
 
 
'==================================================================================================================
' Création de l'arobrescence Sauvegarde_donnée=> Mes Documents / Bureau / PST dans le repertoire cible sélectionné
'==================================================================================================================
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set WshNetwork = CreateObject("WScript.Network")
UserEnCours = WshNetwork.UserName
 
Racine = objPath & "\" & UserEnCours & "\" & "Sauvegarde_données"
 
sub arobrescence
Dim oFSO
 
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set WshNetwork = CreateObject("WScript.Network")
UserEnCours = WshNetwork.UserName
 
'Dim objSysInfo, objUser
'Set objSysInfo = CreateObject("ADSystemInfo")
'Set objUser = GetObject("LDAP://" & objSysInfo.UserName)
'NomComplet = objUser.displayName
 
Racine = objPath & "\" & UserEnCours & "\" & "Sauvegarde_données"
 
Rep_exist_user	 = oFSO.FolderExists(objPath & "\" & UserEnCours)
Rep_exist_racine = oFSO.FolderExists(objPath & "\" & UserEnCours & "\" & "Sauvegarde_données")
Rep_exist_MesDoc = oFSO.FolderExists(objPath & "\" & UserEnCours & "\" & "Sauvegarde_données" & "\" & "Mes documents")
Rep_exist_Bureau = oFSO.FolderExists(objPath & "\" & UserEnCours & "\" & "Sauvegarde_données" & "\" & "Bureau")
Rep_exist_PST 	 = oFSO.FolderExists(objPath & "\" & UserEnCours & "\" & "Sauvegarde_données" & "\" & "Mes PST")
 
 
if Rep_exist_user = true then
 
	if Rep_exist_racine = true then
 
			if Rep_exist_MesDoc = true then
			Else
			MesDocuments=oFSO.CreateFolder (Racine & "\" & "Mes documents")
			End If
 
			if Rep_exist_Bureau = true then
			Else
			Bureau=oFSO.CreateFolder (Racine & "\" & "Bureau")
			End If
 
			if Rep_exist_PST = true then
			Else
			Pst_Folder=oFSO.CreateFolder (Racine & "\" & "Mes PST")
			End If
 
		else
		objPath = objPath & "\" & UserEnCours
		Racine=oFSO.CreateFolder (objPath & "\" & "Sauvegarde_données")
		MesDocuments=oFSO.CreateFolder (Racine & "\" & "Mes documents")
		Bureau=oFSO.CreateFolder (Racine & "\" & "Bureau")
		Pst_Folder=oFSO.CreateFolder (Racine & "\" & "Mes PST")
 
	End If
	else
	objPath=oFSO.CreateFolder(objPath & "\" & UserEnCours)
	Racine=oFSO.CreateFolder (objPath & "\" & "Sauvegarde_données")
	MesDocuments=oFSO.CreateFolder (Racine & "\" & "Mes documents")
	Bureau=oFSO.CreateFolder (Racine & "\" & "Bureau")
	Pst_Folder=oFSO.CreateFolder (Racine & "\" & "Mes PST")
End if
End sub
 
'==================================================================================================================
'Fonction pour backuper le Bureau
'==================================================================================================================
Sub VerifProcessBUR(objProcess)
For Each Process In GetObject("winmgmts:").InstancesOf("Win32_process")
     If UCase(Process.Name) = UCase(objProcess) Then
        msgbox "Annulation de la sauvegarde : " & Process.Name & " est actif..."& Chr(13) &"Fermer Outlook puis relancer l'outils de sauvegarde"
        Exit Sub
     End If
Next
 
backup_Bur()
MsgBox "Sauvegarde terminée"
End Sub
 
sub backup_Bur
 
Set WshShell = CreateObject("WScript.Shell")
MonBur = WShShell.SpecialFolders("Desktop")
 
Dim objFSO, objSourceFolder, objDestinationFolder
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
objSourceFolder = MonBur
objDestinationFolder = Bureau
 
Set oFSO = CreateObject("Scripting.FileSystemObject")
Bureau = Racine & "\" & "Bureau"
 
set fd=oFSO.getfolder(objSourceFolder)
Fd.Copy Bureau,true
 
End sub
 
 
'==================================================================================================================
'Fonction pour backuper mes documents
'==================================================================================================================
Sub VerifProcessDOC(objProcess)
For Each Process In GetObject("winmgmts:").InstancesOf("Win32_process")
     If UCase(Process.Name) = UCase(objProcess) Then
        msgbox "Annulation de la sauvegarde : " & Process.Name & " est actif..."& Chr(13) &"Fermer Outlook puis relancer l'outils de sauvegarde"
        Exit Sub
     End If
Next
 
backup_Doc()
MsgBox "Sauvegarde terminée"
End Sub
 
sub backup_Doc
 
Set WshShell = CreateObject("WScript.Shell")
Mesdoc = WShShell.SpecialFolders("MyDocuments")
 
Dim objFSO, objSourceFolder, objDestinationFolder
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
objSourceFolder = Mesdoc
objDestinationFolder = MesDocuments
 
Set oFSO = CreateObject("Scripting.FileSystemObject")
MesDocuments = Racine & "\" & "Mes documents"
 
set fd=oFSO.getfolder(objSourceFolder)   
Fd.Copy MesDocuments,true
 
End sub
 
'==================================================================================================================
' Fonction pour backuper uniquement les PST présent dans le profil de l'utilisateur en cours
'Détection si Outlook est ouvert pour éviter une erreur de copie.
'==================================================================================================================
 
Sub VerifProcessPST(objProcess)
For Each Process In GetObject("winmgmts:").InstancesOf("Win32_process")
     If UCase(Process.Name) = UCase(objProcess) Then
        msgbox "Annulation de la sauvegarde : " & Process.Name & " est actif..."& Chr(13) &"Fermer Outlook puis relancer l'outils de sauvegarde"
        Exit Sub
     End If
Next
 
backup_PST(objFolder)
MsgBox "Sauvegarde terminée"
End Sub
 
Dim objFS
Dim strFolder
Dim objFolder
 
Set objFS = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
 
Pst_Folder = Racine & "\" & "Mes PST"
strFolder=CreateObject("WScript.Shell").ExpandEnvironmentStrings("%UserProfile%\")
Set objFolder = objFS.GetFolder(strFolder)
 
Sub backup_PST(objDIR)
 
Dim strFile
	For Each eFolder in objDIR.SubFolders
	backup_PST eFolder
    Next
    For Each strFile In objDIR.Files
		strFileName = strFile.Name
		strExtension = objFS.GetExtensionName(strFile)
		If strExtension = "pst" Then
			gobackup = msgbox ("Voulez vous sauvegarder le fichier" & strFile.Name, vbYesNo)
			If gobackup = vbYes then
				objFS.CopyFile strFile , Pst_Folder & "\" & strFileName				
				else
			End If
		End If
    Next
End Sub
 
 
'==================================================================================================================
'Fonction après avoir appuyé sur le bouton continuer.
'Vérifie si un choix est coché et execute le backup de l'option sélectionné.
'==================================================================================================================
 
Sub backup
 
dim reponse
 
if ((Doc.Checked = false) AND (Bur.Checked = false) AND (PST.Checked = false)) then
 
	Msgbox "Veuillez sélectionner une option avant de continuer"
 
	else
	reponse = msgbox ("La sauvegarde peut durer plusieurs minutes, voulez vous continuez ?", vbYesNo)
	If reponse = vbYes then
	msgbox "Démarrage de la sauvegarde, appuyer sur ok"
 
		If Doc.Checked Then
		VerifProcessDOC("outlook.exe")
		End if
 
		If Bur.Checked Then
		VerifProcessBUR("outlook.exe")
		End if
 
		If PST.Checked Then
		VerifProcessPST("outlook.exe")
		End if
 
		Dim WshShell
		Set WshShell = CreateObject("WScript.Shell")
		WshShell.Exec("Explorer " & racine)
		fermer()
		else
		msgbox "Sauvegarde annulée"
		fermer()
	End If
End if
 
End Sub
 
 
</SCRIPT>
<br>
<br>
<br>
<input type="button" id="valider" name="valider" value="Continuer" onclick="backup()">
<input type="button" value="Fermer" border="none" OnClick="fermer()">
</body>
</html>

Maintenant j'arrive a executer xcopy mais la fenêtre dos s'affiche alors que j'aimerai utiliser le paramètre /C mais ne fonctionne pas :

Code:

1
2
 
WshShell.Run("XCOPY /E """ & objSourceFolder & """ """ & MesDocuments & """", 1, True)

J'ai essayé

Code:

1
2
 
WshShell.Run("cmd /C XCOPY /E """ & objSourceFolder & """ """ & MesDocuments & """", 1, True)

06/02/2012, 13h41
hackoofr

Citation:

Envoyé par ponpon17430

Maintenant j'arrive a executer xcopy mais la fenêtre dos s'affiche alors que j'aimerai utiliser le paramètre /C mais ne fonctionne pas :

:salut:
pour cacher la fenêtre Dos il vous suffit de remplacer le paramètre 1 par 0

Code:

WshShell.Run("cmd /C XCOPY /E """ & objSourceFolder & """ """ & MesDocuments & """",0, True)

:salut:
J'ai fait un petit vbscript pour tester la commande Xcopy sur un PC WIN 7 64 bits et il marche 5/5 et voila le code que tu peux l'intégrer aprés modification pour vos besoins dans votre .HTA , Donc ce script fait une sauvegarde totale de votre bureau dans un dossier objDestinationFolder = "c:\HackooXCopy"
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Dim oFSO, objSourceFolder, objDestinationFolder Set WshShell = CreateObject("WScript.Shell") MonBur = WShShell.SpecialFolders("Desktop") Set oFSO = CreateObject("Scripting.FileSystemObject") objSourceFolder = MonBur objDestinationFolder = "c:\HackooXCopy" If Not oFSO.FolderExists(objDestinationFolder) Then set Folder=oFSO.CreateFolder(objDestinationFolder) End If command = "cmd /c xcopy.exe " & Chr(34)& objSourceFolder & Chr(34) &" "& Chr(34) & objDestinationFolder &Chr(34) &" /v /c /d /s /e /H /R /Y" MsgBox command,64,"command pour execution" Resultat = WshShell.Run(Command,0,True)

Merci pour ton script ^^
Entre temps, voici la commande que j'ai et qui fonctionne
Code:

1 2 WshShell.Run "XCOPY /Q /D /J /Y /E """ & objSourceFolder & """ """ & MesDocuments & """", 0, True
Du coup je sauve mes documents et mon bureau (en remplacent la seconde variable.

En revanche Seven commence a m'enerver car mon script pour la copie du PST seul ne fonctionne pas...
J'essai de faire un requete wmi qui fonctionne mais je n'arrive pas a spécifier que la recherche doit se faire dans c:\users\mon user\

voici la requete en question mais sans l'option du repertoire :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 strComputer = "." Set objWMIService = GetObject("winmgmts:" _ & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") Set colFiles = objWMIService. _ ExecQuery("Select * from CIM_DataFile where Extension = 'pst'") For Each objFile in colFiles strCopy = "C:\temp\" & objFile.FileName _ & "." & objFile.Extension objFile.Copy(strCopy) Next
j'ai essayé AND PATH mais je dois me tromper quelque part lol

07/02/2012, 14h06
hackoofr

:salut:
j'ai ajouté récemment [HTA] XCopy Tool qui permet aux utilisateurs de générer une ligne de commande complexe avec XCOPY à l'aide d'un graphique facile d'utilisation.
Alors surtout n'oubliez pas si vous arriviez à résoudre votre problème,nous faire partager votre travail dans la section Contributions et Téléchargements ça nous fait un grand plaisir et surtout ça peut aider d'autres personnes ;) et La connaissance s'accroît quand on la partage :ccool:
Bonne Continuation :pc:
07/02/2012, 16h26
ponpon17430
Je n’hésiterais pas a partager la source de mon hta, pour qu'il soit complet il me manque juste l'écriture d'une ligne avec un robocopy :

en gros je voudrai faire robocopy variable source variable destination *.pst /S
Mais je n'arrive pas a comprendre l'insertion des guillemets...

voici ce que j'ai mais non fonctionnel :
Code:

1 2 3 4 5 6 userprofil = "c:\Documents and Settings\mjean001" strcommand = "CMD /C ""C:\windows\system32\robocopy.exe""" & userprofil & """ c:\temp *.pst /S""" objShell.Run strcommand, 1, true
Edit, c'est bon j'ai la ligne de commande qui fonctionne :
Code:

1 2 strcomamnd = "C:\windows\system32\robocopy " & chr(34) & userprofil & chr(34) & " " & chr(34) & dest & chr(34) & " *.png /S /R:1 /W:3 "
07/02/2012, 18h43
hackoofr
Citation:
Envoyé par ponpon17430

Je n’hésiterais pas a partager la source de mon hta, pour qu'il soit complet il me manque juste l'écriture d'une ligne avec un robocopy :

en gros je voudrai faire robocopy variable source variable destination *.pst /S
Mais je n'arrive pas a comprendre l'insertion des guillemets...

voici ce que j'ai mais non fonctionnel :

Code:

1 2 3 4 5 6 userprofil = "c:\Documents and Settings\mjean001" strcommand = "CMD /C ""C:\windows\system32\robocopy.exe""" & userprofil & """ c:\temp *.pst /S""" objShell.Run strcommand, 1, true
:salut:
Si ça ne marche pas c'est surement un problème d'espaces ou de guillemets mais là dans votre exemple ça se voit un problème d'espace.
vous pouvez aussi ajouté /LOG pour générer un Fichier journal pour tracer vos copies.

Exemple :

Code:

strcommand = "cmd /C Robocopy.exe " & Chr(34)& objSourceFolder & Chr(34) &" "& Chr(34) & objDestinationFolder &Chr(34) &" *.pst /s /LOG+:RoboLog.txt"

Bon j'arrive au bout mais là j'ai un ultime bug que je n'arrive pas à comprendre lol
Lorsque je lance le script, il créé l'arborescence.
ex : c:\temp\user\sauvegarde_données\etc...

Ensuite si je choisis de sauver le PST, ca me trouve bien les PST mais au lieu de mettre dans :
c:\temp\user\sauvegarde_données\etc...
Robocopy me créé l'arbo suivante :
c:\temp\user\user\sauvegarde_données\

En revanche lors de la seconde utilisation du script, ce problème n’apparaît pas...
J'ai beau regarder la déclaration ou la valeur de mes variables, je ne trouve pas ce qui cloche.

voici le code entier :

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
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
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
 
 
<html>
 
<body>
 
<span style="color:#00000;font-family: Verdana;font-size: 13pt">Bienvenue dans l'utilitaire de sauvegarde de vos données personnelles.</span>
 
<br><br>
Sélectionnez le dossier à sauver :
<br>
<br>
<span style="color:red;font-family: Berlin Sans FB Demi">
/!\ Avant de commencer, Veuillez sauvegarder vos documents et fermer Outlook /!\</span>
<br>
<br>
<input type="checkbox" ID="Doc" name="Doc"> : Sauvegarde de Mes Documents (Tous les fichiers)
<br>
<input type="checkbox" ID="Bur" name="Bur"> : Sauvegarde du Bureau (Tous les fichiers)
<br>
<input type="checkbox" ID="PST" name="PST"> : Sauvegarde UNIQUEMENT le/les PST
 
<script type="text/javascript"> 
function fermer() 
{ 
self.close(); 
}  
</script>
<SCRIPT LANGUAGE="VBScript">
ResizeTo 700,400
 
'==================================================================================================================
'Fenêtre pour choisir repertoire cible de sauvegarde
'==================================================================================================================
Const WINDOW_HANDLE = 0
BIF_editbox = &H0010
titre="Sélectionner la destination de la sauvegarde"
Set objShell = CreateObject("Shell.Application" )
Set objFolder = objShell.BrowseForFolder _
    (WINDOW_HANDLE, titre , BIF_editbox)
On Error Resume Next
Set objFolderItem = objFolder.Self
If Err <> 0 Then
        msgbox "Annulation de la sauvegarde"
		fermer()
Else
        objPath = objFolderItem.Path
		arobrescence
end if
 
 
'==================================================================================================================
' Création de l'arobrescence Sauvegarde_donnée=> Mes Documents / Bureau / PST dans le repertoire cible sélectionné
'==================================================================================================================
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set WshNetwork = CreateObject("WScript.Network")
UserEnCours = WshNetwork.UserName
 
Racine = objPath & "\" & UserEnCours & "\" & "Sauvegarde_données"
 
sub arobrescence
Dim oFSO
 
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set WshNetwork = CreateObject("WScript.Network")
UserEnCours = WshNetwork.UserName
 
'Dim objSysInfo, objUser
'Set objSysInfo = CreateObject("ADSystemInfo")
'Set objUser = GetObject("LDAP://" & objSysInfo.UserName)
'NomComplet = objUser.displayName
 
Racine = objPath & "\" & UserEnCours & "\" & "Sauvegarde_données"
 
Rep_exist_user	 = oFSO.FolderExists(objPath & "\" & UserEnCours)
Rep_exist_racine = oFSO.FolderExists(objPath & "\" & UserEnCours & "\" & "Sauvegarde_données")
Rep_exist_MesDoc = oFSO.FolderExists(objPath & "\" & UserEnCours & "\" & "Sauvegarde_données" & "\" & "Mes documents")
Rep_exist_Bureau = oFSO.FolderExists(objPath & "\" & UserEnCours & "\" & "Sauvegarde_données" & "\" & "Bureau")
Rep_exist_PST 	 = oFSO.FolderExists(objPath & "\" & UserEnCours & "\" & "Sauvegarde_données" & "\" & "Mes PST")
 
 
if Rep_exist_user = true then
 
	if Rep_exist_racine = true then
 
			if Rep_exist_MesDoc = true then
			Else
			MesDocuments=oFSO.CreateFolder (Racine & "\" & "Mes documents")
			End If
 
			if Rep_exist_Bureau = true then
			Else
			Bureau=oFSO.CreateFolder (Racine & "\" & "Bureau")
			End If
 
			if Rep_exist_PST = true then
			Else
			Pst_Folder=oFSO.CreateFolder (Racine & "\" & "Mes PST")
			End If
 
		else
		objPath = objPath & "\" & UserEnCours
		Racine=oFSO.CreateFolder (objPath & "\" & "Sauvegarde_données")
		MesDocuments=oFSO.CreateFolder (Racine & "\" & "Mes documents")
		Bureau=oFSO.CreateFolder (Racine & "\" & "Bureau")
		Pst_Folder=oFSO.CreateFolder (Racine & "\" & "Mes PST")
 
	End If
	else
	objPath=oFSO.CreateFolder(objPath & "\" & UserEnCours)
	Racine=oFSO.CreateFolder (objPath & "\" & "Sauvegarde_données")
	MesDocuments=oFSO.CreateFolder (Racine & "\" & "Mes documents")
	Bureau=oFSO.CreateFolder (Racine & "\" & "Bureau")
	Pst_Folder=oFSO.CreateFolder (Racine & "\" & "Mes PST")
End if
End sub
 
'==================================================================================================================
'Fonction pour backuper le Bureau
'==================================================================================================================
Sub VerifProcessBUR(objProcess)
For Each Process In GetObject("winmgmts:").InstancesOf("Win32_process")
     If UCase(Process.Name) = UCase(objProcess) Then
        msgbox "Annulation de la sauvegarde : " & Process.Name & " est actif..."& Chr(13) &"Fermer Outlook puis relancer l'outils de sauvegarde"
        Exit Sub
     End If
Next
 
backup_Bur()
MsgBox "Sauvegarde terminée"
End Sub
 
sub backup_Bur
 
Set WshShell = CreateObject("WScript.Shell")
MonBur = WShShell.SpecialFolders("Desktop")
 
Dim objFSO, objSourceFolder, objDestinationFolder
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
objSourceFolder = MonBur
objDestinationFolder = Bureau
 
Set oFSO = CreateObject("Scripting.FileSystemObject")
Bureau = Racine & "\" & "Bureau"
 
set fd=oFSO.getfolder(objSourceFolder)
Fd.Copy Bureau,true
 
End sub
 
 
'==================================================================================================================
'Fonction pour backuper mes documents
'==================================================================================================================
Sub VerifProcessDOC(objProcess)
For Each Process In GetObject("winmgmts:").InstancesOf("Win32_process")
     If UCase(Process.Name) = UCase(objProcess) Then
        msgbox "Annulation de la sauvegarde : " & Process.Name & " est actif..."& Chr(13) &"Fermer Outlook puis relancer l'outils de sauvegarde"
        Exit Sub
     End If
Next
 
backup_Doc()
MsgBox "Sauvegarde terminée"
End Sub
 
sub backup_Doc
 
Set WshShell = CreateObject("WScript.Shell")
Mesdoc = WShShell.SpecialFolders("MyDocuments")
 
Dim objFSO, objSourceFolder, objDestinationFolder
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
objSourceFolder = Mesdoc
objDestinationFolder = MesDocuments
 
Set oFSO = CreateObject("Scripting.FileSystemObject")
MesDocuments = Racine & "\" & "Mes documents"
 
set fd=oFSO.getfolder(objSourceFolder)   
Fd.Copy MesDocuments,true
 
End sub
 
'==================================================================================================================
' Fonction pour backuper uniquement les PST présent dans le profil de l'utilisateur en cours
'Détection si Outlook est ouvert pour éviter une erreur de copie.
'==================================================================================================================
 
Sub VerifProcessPST(objProcess)
For Each Process In GetObject("winmgmts:").InstancesOf("Win32_process")
     If UCase(Process.Name) = UCase(objProcess) Then
        msgbox "Annulation de la sauvegarde : " & Process.Name & " est actif..."& Chr(13) &"Fermer Outlook puis relancer l'outils de sauvegarde"
        Exit Sub
     End If
Next
 
backup_PST
MsgBox "Sauvegarde terminée"
End Sub
 
Sub backup_PST
 
Dim objFS, strFolder, objFolder
 
Set objFS = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
 
Pst_Folder = Racine & "\" & "Mes PST"
strFolder=CreateObject("WScript.Shell").ExpandEnvironmentStrings("%UserProfile%\")
Set objFolder = objFS.GetFolder(strFolder)
 
userprofil = WshShell.ExpandEnvironmentStrings("%USERPROFILE%")
strcommand = "C:\windows\system32\robocopy " & chr(34) & userprofil & chr(34) & " " & chr(34) & Pst_Folder & chr(34) & " *.pst /S /R:1 /W:2 /XD *Temp*"
 
WshShell.Run strcommand, 1, true 
 
End Sub
 
 
'==================================================================================================================
'Fonction après avoir appuyé sur le bouton continuer.
'Vérifie si un choix est coché et execute le backup de l'option sélectionné.
'==================================================================================================================
 
Sub backup
 
dim reponse
 
if ((Doc.Checked = false) AND (Bur.Checked = false) AND (PST.Checked = false)) then
 
	Msgbox "Veuillez sélectionner une option avant de continuer"
 
	else
	reponse = msgbox ("La sauvegarde peut durer plusieurs minutes, voulez vous continuez ?", vbYesNo)
	If reponse = vbYes then
	msgbox "Démarrage de la sauvegarde, appuyer sur ok"
 
		If Doc.Checked Then
		VerifProcessDOC("outlook.exe")
		End if
 
		If Bur.Checked Then
		VerifProcessBUR("outlook.exe")
		End if
 
		If PST.Checked Then
		VerifProcessPST("outlook.exe")
		End if
 
		Dim WshShell
		Set WshShell = CreateObject("WScript.Shell")
		WshShell.Exec("Explorer " & racine)
		fermer()
		else
		msgbox "Sauvegarde annulée"
		fermer()
	End If
End if
 
End Sub
 
 
</SCRIPT>
<br>
<br>
<br>
<input type="button" id="BTvalider" name="valider" value="Continuer" onclick="backup()">
<input type="button" Id="BTFermer" name="BTFermer" value="Fermer"  OnClick="fermer()">
</body>
</html>

Edit, c'est bon j'ai trouvé, en fait j'ai modifié toutes les variables

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
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
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
 
 
<html>
 
<body>
 
<span style="color:#00000;font-family: Verdana;font-size: 13pt">Bienvenue dans l'utilitaire de sauvegarde de vos données personnelles.</span>
 
<br><br>
Sélectionnez le dossier à sauver :
<br>
<br>
<span style="color:red;font-family: Berlin Sans FB Demi">
/!\ Avant de commencer, Veuillez sauvegarder vos documents et fermer Outlook /!\</span>
<br>
<br>
<input type="checkbox" ID="Doc" name="Doc"> : Sauvegarde de Mes Documents (Tous les fichiers)
<br>
<input type="checkbox" ID="Bur" name="Bur"> : Sauvegarde du Bureau (Tous les fichiers)
<br>
<input type="checkbox" ID="PST" name="PST"> : Sauvegarde UNIQUEMENT le/les PST
 
<script type="text/javascript"> 
function fermer() 
{ 
self.close(); 
}  
</script>
<SCRIPT LANGUAGE="VBScript">
ResizeTo 700,400
 
'==================================================================================================================
'Fenêtre pour choisir repertoire cible de sauvegarde
'==================================================================================================================
Const WINDOW_HANDLE = 0
BIF_editbox = &H0010
titre="Sélectionner la destination de la sauvegarde"
Set objShell = CreateObject("Shell.Application" )
Set objFolder = objShell.BrowseForFolder _
    (WINDOW_HANDLE, titre , BIF_editbox)
On Error Resume Next
Set objFolderItem = objFolder.Self
If Err <> 0 Then
        msgbox "Annulation de la sauvegarde"
		fermer()
Else
        objPath = objFolderItem.Path
		arobrescence
end if
 
 
'==================================================================================================================
' Création de l'arobrescence Sauvegarde_donnée=> Mes Documents / Bureau / PST dans le repertoire cible sélectionné
'==================================================================================================================
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set WshNetwork = CreateObject("WScript.Network")
UserEnCours = WshNetwork.UserName
 
 
Racine = objPath & "\" & UserEnCours & "\" & "Sauvegarde_données"
 
sub arobrescence
Dim oFSO
 
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set WshNetwork = CreateObject("WScript.Network")
UserEnCours = WshNetwork.UserName
 
'Dim objSysInfo, objUser
'Set objSysInfo = CreateObject("ADSystemInfo")
'Set objUser = GetObject("LDAP://" & objSysInfo.UserName)
'NomComplet = objUser.displayName
 
Racine = objPath & "\" & UserEnCours & "\" & "Sauvegarde_données"
 
Rep_exist_user	 = oFSO.FolderExists(objPath & "\" & UserEnCours)
Rep_exist_racine = oFSO.FolderExists(objPath & "\" & UserEnCours & "\" & "Sauvegarde_données")
Rep_exist_MesDoc = oFSO.FolderExists(objPath & "\" & UserEnCours & "\" & "Sauvegarde_données" & "\" & "Mes documents")
Rep_exist_Bureau = oFSO.FolderExists(objPath & "\" & UserEnCours & "\" & "Sauvegarde_données" & "\" & "Bureau")
Rep_exist_PST 	 = oFSO.FolderExists(objPath & "\" & UserEnCours & "\" & "Sauvegarde_données" & "\" & "Mes PST")
 
 
if Rep_exist_user = true then
 
	if Rep_exist_racine = true then
 
			if Rep_exist_MesDoc = true then
			Else
			MesDocuments=oFSO.CreateFolder (objPath & "\" & UserEnCours & "\" & "Sauvegarde_données" & "\" & "Mes documents")
			End If
 
			if Rep_exist_Bureau = true then
			Else
			Bureau=oFSO.CreateFolder (objPath & "\" & UserEnCours & "\" & "Sauvegarde_données" & "\" & "Bureau")
			End If
 
			if Rep_exist_PST = true then
			Else
			Pst_Folder=oFSO.CreateFolder (objPath & "\" & UserEnCours & "\" & "Sauvegarde_données" & "\" & "Mes PST")
			End If
 
		else
		Racine=oFSO.CreateFolder (objPath & "\" & UserEnCours & "\" & "Sauvegarde_données")
		MesDocuments=oFSO.CreateFolder (objPath & "\" & UserEnCours & "\" & "Sauvegarde_données" & "\" & "Mes documents")
		Bureau=oFSO.CreateFolder (objPath & "\" & UserEnCours & "\" & "Sauvegarde_données" & "\" & "Bureau")
		Pst_Folder=oFSO.CreateFolder (objPath & "\" & UserEnCours & "\" & "Sauvegarde_données" & "\" & "Mes PST")
 
	End If
	else
	objPath1=oFSO.CreateFolder(objPath & "\" & UserEnCours)
	Racine=oFSO.CreateFolder (objPath & "\" & UserEnCours & "\" & "Sauvegarde_données")
	MesDocuments=oFSO.CreateFolder (objPath & "\" & UserEnCours & "\" & "Sauvegarde_données" & "\" & "Mes documents")
	Bureau=oFSO.CreateFolder (objPath & "\" & UserEnCours & "\" & "Sauvegarde_données" & "\" & "Bureau")
	Pst_Folder=oFSO.CreateFolder (objPath & "\" & UserEnCours & "\" & "Sauvegarde_données" & "\" & "Mes PST")
End if
End sub
 
'==================================================================================================================
'Fonction pour backuper le Bureau
'==================================================================================================================
Sub VerifProcessBUR(objProcess)
For Each Process In GetObject("winmgmts:").InstancesOf("Win32_process")
     If UCase(Process.Name) = UCase(objProcess) Then
        msgbox "Annulation de la sauvegarde : " & Process.Name & " est actif..."& Chr(13) &"Fermer Outlook puis relancer l'outils de sauvegarde"
        Exit Sub
     End If
Next
 
backup_Bur()
 
End Sub
 
sub backup_Bur
 
Set WshShell = CreateObject("WScript.Shell")
MonBur = WShShell.SpecialFolders("Desktop")
 
Dim objFSO, objSourceFolder
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
objSourceFolder = MonBur
 
Set oFSO = CreateObject("Scripting.FileSystemObject")
Bureau = objPath & "\" & UserEnCours & "\" & "Sauvegarde_données" & "\" & "Bureau"
 
WshShell.Run "XCOPY /Q /D /Y /E """ & objSourceFolder & """ """ & Bureau & """", 0, True
 
End sub
 
 
'==================================================================================================================
'Fonction pour backuper mes documents
'==================================================================================================================
Sub VerifProcessDOC(objProcess)
For Each Process In GetObject("winmgmts:").InstancesOf("Win32_process")
     If UCase(Process.Name) = UCase(objProcess) Then
        msgbox "Annulation de la sauvegarde : " & Process.Name & " est actif..."& Chr(13) &"Fermer Outlook puis relancer l'outils de sauvegarde"
        Exit Sub
     End If
Next
 
backup_Doc()
 
End Sub
 
sub backup_Doc
 
Set WshShell = CreateObject("WScript.Shell")
Mesdoc = WShShell.SpecialFolders("MyDocuments")
 
Dim objFSO, objSourceFolder
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
objSourceFolder = Mesdoc
 
Set oFSO = CreateObject("Scripting.FileSystemObject")
MesDocuments = objPath & "\" & UserEnCours & "\" & "Sauvegarde_données" & "\" & "Mes documents"
 
WshShell.Run "XCOPY /Q /D /Y /E """ & objSourceFolder & """ """ & MesDocuments & """", 0, True
 
End sub
 
'==================================================================================================================
' Fonction pour backuper uniquement les PST présent dans le profil de l'utilisateur en cours
'Détection si Outlook est ouvert pour éviter une erreur de copie.
'==================================================================================================================
 
Sub VerifProcessPST(objProcess)
For Each Process In GetObject("winmgmts:").InstancesOf("Win32_process")
     If UCase(Process.Name) = UCase(objProcess) Then
        msgbox "Annulation de la sauvegarde : " & Process.Name & " est actif..."& Chr(13) &"Fermer Outlook puis relancer l'outils de sauvegarde"
        Exit Sub
     End If
Next
 
backup_PST
 
End Sub
 
Sub backup_PST
 
Dim objFS, strFolder, objFolder
 
Set objFS = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
 
Pst_Folder = objPath & "\" & UserEnCours & "\" & "Sauvegarde_données" & "\" & "Mes PST"
strFolder=CreateObject("WScript.Shell").ExpandEnvironmentStrings("%UserProfile%\")
Set objFolder = objFS.GetFolder(strFolder)
 
userprofil = WshShell.ExpandEnvironmentStrings("%USERPROFILE%")
strcommand = "C:\windows\system32\robocopy " & chr(34) & userprofil & chr(34) & " " & chr(34) & Pst_Folder & chr(34) & " *.pst /S /R:1 /W:2 /XD *Temp*"
 
WshShell.Run strcommand, 1, true 
 
End Sub
 
 
'==================================================================================================================
'Fonction après avoir appuyé sur le bouton continuer.
'Vérifie si un choix est coché et execute le backup de l'option sélectionné.
'==================================================================================================================
 
Sub backup
 
dim reponse
 
if ((Doc.Checked = false) AND (Bur.Checked = false) AND (PST.Checked = false)) then
 
	Msgbox "Veuillez sélectionner une option avant de continuer"
 
	else
	reponse = msgbox ("La sauvegarde peut durer plusieurs minutes, voulez vous continuez ?", vbYesNo)
	If reponse = vbYes then
	msgbox "Démarrage de la sauvegarde, appuyer sur ok"
 
		If Doc.Checked Then
		VerifProcessDOC("outlook.exe")
		End if
 
		If Bur.Checked Then
		VerifProcessBUR("outlook.exe")
		End if
 
		If PST.Checked Then
		VerifProcessPST("outlook.exe")
		End if
		MsgBox "Sauvegarde terminée"
		Dim WshShell
		Set WshShell = CreateObject("WScript.Shell")
		WshShell.Exec("Explorer " & racine)
		fermer()
		else
		msgbox "Sauvegarde annulée"
		fermer()
	End If
End if
 
End Sub
 
 
</SCRIPT>
<br>
<br>
<br>
<input type="button" id="BTvalider" name="valider" value="Continuer" onclick="backup()">
<input type="button" Id="BTFermer" name="BTFermer" value="Fermer"  OnClick="fermer()">
</body>
</html>

Voila voila tout fonctionne normalement