Salut ! Voila un Script de Mr "JC Bellamy" qui fait la Sauvegarde des dossiers spéciaux de l'utilisateur en cours.
-NB : il faut fermer toutes les applications en cours d'exécution afin que le script marche très bien et sans conflit.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
' ----------------------------------------------------------------
' Script de backup des dossiers spéciaux de l'utilisateur en cours
' (A exécuter de préférence avec cscript)
'
' Syntaxe: 
'	backupspecial [<répertoire_de_destination>]
' Si répertoire de destination est omis,
' la copie a lieu dans %temp%\%username%
' Le répertoire de destination peut exister ou non
'
' JC BELLAMY © 2001
' ----------------------------------------------------------------
Dim net, shell, args, fso, fldrs, spf, dirtemp, fdest
Set net   = Wscript.CreateObject("WScript.Network")
Set shell = WScript.CreateObject("WScript.Shell")
Set fso   = WScript.CreateObject("Scripting.FileSystemObject")
Set args  = Wscript.Arguments
If args.count=0 Then
	User=net.UserName
	Set dirtemp = fso.GetSpecialFolder(2)
	dest=dirtemp & "\" & user
Else
	dest=args(0)
	End If
If right(dest,1)="\" Then dest=left(dest,len(dest)-1)
 
' Création récursive du dossier destination s'il n'existe pas
If not fso.FolderExists(dest) Then SuperCreateFolder dest
 
dest=dest & "\"
Set fldrs=Shell.SpecialFolders
spf=array("AppData","Desktop","Favorites","MyDocuments", _
          "NetHood","PrintHood","Programs","Recent", _
		  "SendTo","StartMenu","Templates")
wscript.echo "Copie des dossiers spéciaux du compte " & user & " vers " & dest
For i = 0 to UBound(spf)
	curfolder=fldrs(spf(i))
	wscript.echo curfolder
	fso.CopyFolder curfolder, dest, true
	next
' Effacement éventuel des attributs système des fichiers 
' afin de permettre un autre backup
wscript.echo "Effacement des attributs RHS"
ResetAllAttrib dest 
Wscript.quit
 
'--------------------------------------------------------------------
' sous-programme de création récursive de dossier
Sub SuperCreateFolder(fd)
If fd="" Then exit sub
bs=InstrRev(fd,"\")
parent=left(fd,bs-1)
If len(parent)>2 Then
	If not fso.FolderExists(parent) then SuperCreateFolder Parent
	End If
fso.CreateFolder(fd)
End Sub
'--------------------------------------------------------------------
' sous-programme d'effacement récursif des attributs RHS
Sub ResetAllAttrib(fd)
dim collSubfolder,collFiles,subfd,curfile,curfd
set curfd=fso.GetFolder(fd) 
curfd.Attributes=ResetAttrib(curfd.Attributes)
set collSubfolder=curfd.SubFolders 
For each subfd in collSubfolder
	ResetAllAttrib subfd.path
	Next
set collFiles=curfd.Files
For each curfile in collFiles
	curfile.Attributes=ResetAttrib(curfile.Attributes)
	Next
End Sub
'--------------------------------------------------------------------
Function ResetAttrib(Attr)
ReadOnly=1
Hidden=2
System=4
If Attr and ReadOnly Then Attr=Attr-ReadOnly
If Attr and Hidden Then Attr=Attr-Hidden
If Attr and System Then Attr=Attr-System
ResetAttrib=Attr
End Function
'--------------------------------------------------------------------