Copie de fichier + création arborescence [Résolu]

[ponpon17430]

Bonjour,

Je suis entrain de faire un petit outil pour sauver mes données mais je rencontre un problème.
Je veux copier tout les fichiers doc qui se situe dans Mes documents
J'arrive a copier ce qui est à la racine / dans un sous répertoire mais pas dans un sous-sous répertoire.

J'ai essayé un script dans les FAQ pour créer une arborescence mais je n'y arrive pas.
voila mon 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
 
'Fenêtre pour choisir repertoire cible de sauvegarde
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = 0
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder _
    (WINDOW_HANDLE, "Select a folder:", NO_OPTIONS, "C:\Scripts")       
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path & "\"
 
Set objFS = CreateObject("Scripting.FileSystemObject")
strFolder_MesDoc=CreateObject("WScript.Shell").ExpandEnvironmentStrings("%UserProfile%\Mes documents\")
 
Set objFolder = objFS.GetFolder(strFolder_MesDoc)
 
'fonction pour lister / copier les fichiers doc docx
 
Sub Godoc(objDIR)
 
If objDIR <> "\System Volume Information" Then
	For Each eFolder in objDIR.SubFolders   	
		Godoc eFolder
	Next
	For Each strFile In objDIR.Files
 
		strFileName = strFile.Name
		strExtension = objFS.GetExtensionName(strFile)
		If strExtension = "doc" Then
			objPath2 =  MesDoc & "\" & objDIR.name & "\"
 
 
'Création des repertoires présents dans mes documents dans la repertoire de sauvegarde.
Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FolderExists(objPath2) Then
else
Dim oFld 
'Crée le repertoire
Set oFld=oFSO.CreateFolder (objPath2)
End IF
 
objFS.CopyFile strFile , objPath2 & strFileName
else 
If strExtension = "docx" Then
objFS.CopyFile strFile , objPath2 & strFileName
End If
End If
Next    
End If  
End Sub

[hackoofr]

J'ai posté un Vbscript dans la section Contributions et Téléchargements peut-être qu'il vous donne d'autres idées a propos de ce que vous cherchiez comme Recherche & Sauvegarde des fichiers par leurs Extensions

[ponpon17430]

Hello,

Merci pour ton aide mais lorsque je lance ton script pour tester j'ai l'erreur suivante :
L'exception Exception logicielle inconnue(0xc0000409) s'est produite dans l'application à l'emplacement 0x46d27242.

Mais par contre je ne vois pas dans tous les cas comme créer une arborescence avec des sous dossiers

Edit :
Ma recherche me trouve bien les fichiers dans les sous répertoires même sous sous répertoire mais vu que je veux copier le fichier en créant la même arborescence, la copie ne se fait pas car mon script n'arrive pas a créer deux répertoires a la suite ou plutot l'arbre directement.

[hackoofr]

Envoyé par ponpon17430

Hello,
Merci pour ton aide mais lorsque je lance ton script pour tester j'ai l'erreur suivante :
L'exception Exception logicielle inconnue(0xc0000409) s'est produite dans l'application à l'emplacement 0x46d27242.

Dans la ligne N°83 il y a

Call SplashScreen 'Lançement du Splash Screen
Commente ou bien supprime là et réessayer d’exécuter le script de nouveau et dis-moi si vous recevez la même erreur ou non

[ponpon17430]

Le problème est reste identique même après un reboot de la machine.
Par contre c'est sur mon disque C que ca ne fonctionne pas.
Si je mets la lettre de ma clef usb, là c'est ok

[hackoofr]

Envoyé par ponpon17430

Le problème est reste identique même après un reboot de la machine.
Par contre c'est sur mon disque C que ca ne fonctionne pas.
Si je mets la lettre de ma clef usb, là c'est ok

Donc vous avez un problème dans votre disque dur C:\
essayez de lancer la commande CHKDSK pour vérifier et corriger les erreurs

CHKDSK /F C:

[ponpon17430]

Ca doit surement être cela, car je viens de tester sur un lecteur réseau et c'est ok.
bref j'arrive a comprendre le fonctionnement de ton script mais ce que j'aimerai faire c'est lancer une recherche sur le répertoire mes documents et ensuite le script me créé l'arborescence mais là je ne trouve pas grand chose sur le net.
J'arrive a créé une arborescence sur deux niveaux mais si je veux plus il faut que je fasse a chaque fois une boule for... je pense qu'il y a une autre solution mais je ne la trouve pas.

une petite idée ? lol

[Pasokoniidesuka]

Juste pour info.
On peut accéder à mes documents via la méthode SpecialFolders

Code :

1
2
3
 
Set WshShell = WScript.CreateObject("WScript.Shell")
WScript.Echo WShShell.SpecialFolders("MyDocuments")

Ce snippet issue du livre Windows Scripting Host chez eni Editions (au détail près : MesDocuments remplacé par MyDocuments) est celui que j'ai utilisé pour apprendre VBS mais je tiens à pointer du doigt une erreur dans le livre qui présente la chose comme si on pouvait utiliser les noms français. Donc on devrait coder pour chaque langue. Imaginez qu'on soit obligé d'écrire 私のドキュメント en japonais dans le script... Non heureusement c'est faux et tout est basé sur les dénominations anglaises.
D'ailleurs il y a un encadré dans la FAQ VBS sur SpecialFolders.
Pourquoi utiliser SpecialFolders ?
J'ai pu travailler dans une structure où on déplaçait le dossier Mes Documents sur une autre partition donc plus dans le traditionnel lecteur C:\
Coder le chemin en dur c'est bien mais il est moins portable au cas où quelqu'un qui aurait déplacé le dossier utilise le script. Il doit le modifier.

Voilà. C'est juste une petite remarque.

[ponpon17430]

Bonjour,

Merci pour ta contribution même si cela ne m'avance pas beaucoup lol mais ca me permet d'améliorer une partie de mon script

Bon j'ai contourner mon problème mais bien contourné lol
Je copie directement l'ensemble du repertoire mes documents.

En revanche, est possible de l'afficher a la fin ? car j'ai essayé en mettant

Code :

1
2
3
 
Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec("monchemin")

Mais ca m'indique accès non autorisé alors que si j'execute cela dans un autre vbs ca fonctionne...

[Pasokoniidesuka]

Pas sur d'avoir compris mais a mon avis tu veux afficher une fenêtre sur ta variable monchemin.
Suffit de faire explorer.exe monchemin à la place. ^^
PS : Même pas la peine de mettre le exe j'ai vérifié avec ce code là :

Code :

1
2
3
4
5
Option Explicit
Dim WshShell, monchemin
monchemin = "e:\Apps\Productivite\Developpement"
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Exec("Explorer " & monchemin)

[ponpon17430]

Impec !
Merci

Problème résolu

[ponpon17430]

Bon bin en fait c'est pas tout a fait résolu pour mon script
Le voici en 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
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
 
 
<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 fermer toutes vos applications en cours /!\</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
BIF_returnonlyfsdirs   = &H0001
BIF_dontgobelowdomain  = &H0002
BIF_editbox            = &H0010
BIF_validate           = &H0020
BIF_browseforcomputer  = &H1000
 
Dim shell, item
Set shell = CreateObject("Shell.Application")
flag=BIF_returnonlyfsdirs 
titre="Sélectionner la destination de la sauvegarde"
Set Item = shell.BrowseForFolder(0,titre,flag, dirinit)
If isvalue(Item) Then
	objPath=Item.Title
' Test si on a sélectionné la racine d'une partition 
	If InStr(1,objPath,":")=0 Then
		objPath=Item.ParentFolder.ParseName(Item.Title).Path
		End If
		arobrescence
else
	msgbox "Annulation de la sauvegarde"
	fermer()
	End If
 
' Vérifie si un répertoire a été sélectionné
Function IsValue(obj)
Dim tmp
On Error Resume Next
tmp = " " & obj
If Err <> 0 Then IsValue = False Else IsValue = True
On Error GoTo 0
End Function
 
'==================================================================================================================
' Création de l'arobrescence Sauvegarde_donnée=> Mes Documents / Bureau / PST dans le repertoire cible sélectionné
'==================================================================================================================
Racine = objPath & "\" & "Sauvegarde_données"
sub arobrescence
Dim oFSO
 
Racine = objPath & "\" & "Sauvegarde_données"
Set oFSO = CreateObject("Scripting.FileSystemObject")
 
Rep_existe_racine = oFSO.FolderExists(Racine)
Rep_existe_MesDoc = oFSO.FolderExists(Racine & "\" & "Mes documents")
Rep_existe_Bureau = oFSO.FolderExists(Racine & "\" & "Bureau")
Rep_existe_PST = oFSO.FolderExists(Racine & "\" & "Mes PST")
 
if Rep_existe_racine = true then
 
	if Rep_existe_MesDoc = true then
	Else
	MesDocuments=oFSO.CreateFolder (Racine & "\" & "Mes documents")
	End If
 
	if Rep_existe_Bureau = true then
	Else
	Bureau=oFSO.CreateFolder (Racine & "\" & "Bureau")
	End If
 
	if Rep_existe_PST = true then
	Else
	Pst_Folder=oFSO.CreateFolder (Racine & "\" & "Mes PST")
	End If
 
	else
	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 backup_Bur
 
Set WshShell = CreateObject("WScript.Shell")
 
'MonBur est le repertoire mes documents de l'utilisateur en cours
 
MonBur = WShShell.SpecialFolders("Desktop")
 
 Dim objFSO, objWshell, oIE, oIEDoc, objSourceFolder, objDestinationFolder
 
 set objWshell = CreateObject("Wscript.Shell")
 Set oIE = CreateObject("InternetExplorer.Application")
 oIE.Navigate "about:blank"
 do while oIE.busy : wscript.sleep 10 : loop
 Set oIEDoc = oIE.Document
 
 oIE.AddressBar = False
 oIE.StatusBar = False
 oIE.ToolBar = False
 oIE.Document.Body.Scroll = "no"
 oIE.document.title = "Utilitaire backup"
 oIE.height=100
 oIE.width=200
 oIE.Resizable = False
 oIE.Visible = True
 
sMsg= "<center>Sauvegarde en cours<br>Please wait...<br><br>"
 oIEDoc.Body.Innerhtml= sMsg
 
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 Set WshShell = CreateObject("WScript.Shell")
 
 objSourceFolder = MonBur
 objDestinationFolder = Bureau
 
 
Set oFSO = CreateObject("Scripting.FileSystemObject")
Bureau = Racine & "\" & "Bureau"
 
set fd=oFSO.getfolder(objSourceFolder)   
Fd.Copy Bureau,true
 
 Set oIEDoc = Nothing
 oIE.Quit
 Set oIE = Nothing
 
' Set objFSO = Nothing
' Set objWshell = Nothing
' Set WshShell = Nothing
 
End sub
 
 
'==================================================================================================================
'Fonction pour backuper mes documents
'==================================================================================================================
 
sub backup_Doc
 
Set WshShell = CreateObject("WScript.Shell")
 
'MesDoc est le repertoire mes documents de l'utilisateur en cours
 
Mesdoc = WShShell.SpecialFolders("MyDocuments")
 
 Dim objFSO, objWshell, oIE, oIEDoc, objSourceFolder, objDestinationFolder
 
 set objWshell = CreateObject("Wscript.Shell")
 Set oIE = CreateObject("InternetExplorer.Application")
 oIE.Navigate "about:blank"
 do while oIE.busy : wscript.sleep 10 : loop
 Set oIEDoc = oIE.Document
 
 oIE.AddressBar = False
 oIE.StatusBar = False
 oIE.ToolBar = False
 oIE.Document.Body.Scroll = "no"
 oIE.document.title = "Utilitaire backup"
 oIE.height=100
 oIE.width=200
 oIE.Resizable = False
 oIE.Visible = True
 
 
sMsg= "<center>Sauvegarde en cours<br>Please wait...<br><br>"
 
 oIEDoc.Body.Innerhtml= sMsg
 
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 Set WshShell = CreateObject("WScript.Shell")
 
 objSourceFolder = Mesdoc
 objDestinationFolder = MesDocuments
 
 
Set oFSO = CreateObject("Scripting.FileSystemObject")
MesDocuments = Racine & "\" & "Mes documents"
 
set fd=oFSO.getfolder(objSourceFolder)   
Fd.Copy MesDocuments,true
 
 Set oIEDoc = Nothing
 oIE.Quit
 Set oIE = Nothing
 
' Set objFSO = Nothing
' Set objWshell = Nothing
' Set WshShell = Nothing
 
End sub
 
'==================================================================================================================
' Fonction pour backuper uniquement les PST présent dans le profil de l'utilisateur en cours
'==================================================================================================================
 
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,true				
				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
 
	If Doc.Checked Then
 
	backup_Doc()
	End if
 
	If Bur.Checked Then
 
	backup_Bur()
	End if
 
	If PST.Checked Then
 
	backup_PST(objFolder)
	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="valider" name="valider" value="Continuer" onclick="backup()">
<input type="button" value="Fermer" border="none" OnClick="fermer()">
</body>
</html>

Et voila mon problème, lorsque je veux sauver les fichiers du bureau ou de mes documents, j'ouvre une fenetre IE indiquant que la copie est en cours mais elle reste en arrière plan.

J'ai a ce moment voulu modifier cela et utiliser l'option innerhtml mais le problème et que la fonction se lance et après ca affiche mon text pourtant je place la fonction avant l'execution du script de copie

J'ai tenté comme cela dans mon body après mes deux boutons

Code :

<span id = "test"></span>

Ensuite j'ai créé une fonction :

Code :

1
2
3
4
 
Sub affiche
    test.innerhtml = "Test en cours"
End Sub

Puis après "If reponse = vbYes then"
j'ai appelé ma fonction mais elle s'execute a la fin...
en revanche si j'appelle ma fonction après cette ligne "Sub backup"
Là ca fonctionne sauf que je peux toujours annuler la sauvegarde donc le message apparait inutilement

EDIT : Bon je ne sais pas pourquoi mais si je met un msgbox après là ca fonctionne.
Du coup je vais essayer de mettre un sleep.

EDIT 2 : Je tente de mettre un simple wscript.sleep 1200 (avec ou sans parenthèse) et ca m'indique objet requis

[hackoofr]

Envoyé par ponpon17430

Je tente de mettre un simple wscript.sleep 1200 (avec ou sans parenthèse) et ca m'indique objet requis

Vous ne pouvez pas utiliser le WScript.Sleep dans une Application HTA.
Mais pour contourner ce genre de problème, vous pouvez utiliser cette astuce trouvé dans un forum anglais.

Code :

1
2
3
4
5
6
7
8
9
Sub Sleep(MSecs) 
 Set fso = CreateObject("Scripting.FileSystemObject")
  If Fso.FileExists("sleeper.vbs")=False Then
  Set objOutputFile = fso.CreateTextFile("sleeper.vbs", True)
  objOutputFile.Write "wscript.sleep WScript.Arguments(0)"
  objOutputFile.Close
  End If
 CreateObject("WScript.Shell").Run "sleeper.vbs " & MSecs,1 , True
 End Sub

et vous avez maintenant une fonction Sleep qui marche parfaitement sans aucune erreur et il vous suffit de l'appeler comme ceci

Code :

Sleep 1200

[Pasokoniidesuka]

Bon toujours pas de super réponse qui résolve tout de ma part mais j'ai parcouru le script et j'aimerais faire quelques remarques.
Ça ne va jamais bien loin mais :

• J'ai l'impression que vous créez plusieurs instances du même objet pour rien. (Je me trompe peut-être mais j'ai cette impression là.)
• C'est pas pour faire mon "chiant" mais les mots clés pas en majuscules (au moins la première lettre) et l'indentation un peu bancale par endroits (ou peut-être que c'est la fonction "sélectionner tout" de dev.net qui ferait déconner l'indentation, je ne sais pas) faudrait y repenser. Être rigoureux est une qualité quand on code.
• Ensuite j'ai l'impression que vos fonctions backup_Bur et backup_Doc font la même chose. Pourquoi ne pas faire une fonction générique backup (source, destination) par exemple et n'utiliser que celle-ci avec les arguments ad-hoc ?

Maintenant j'ai encore une chose à proposer. J'ai pu travailler dans une structure où les sauvegardes reposaient sur une commande qui s'appelle robocopy. C'est une sorte de rsync sous Windows et cette commande est vraiment géniale. Il faut juste s'assurer que vous possédez la commande sur votre (vos ?) système. Si c'est le cas alors le gain de temps serait faramineux. En effet il ne s’agirait plus d'une "bête" copie systématique mais de synchronisation. J'ai utilisé cette commande pour mes sauvegardes personnelles. La commande est disponible sous Seven et je pense aussi Vista. Pour XP j'avais du installer un ressource kit pour Windows Server 2003 mais ça marche très bien. A noter que la version RK Win2003 Svr est plus ancienne que celle de Seven mais elle est suffisante pour la plupart des cas.
Ressource Kit Windows Server 2003
Infos sur la commande
Exemples d'utilisation

[ponpon17430]

Merci pour vos réponse.
Effectivement le code pourrait être plus clair et simplifié mais je ne suis pas un expert en vbs donc je tente d'améliorer petit a petit mon script.
Concernant le passage de variable dans une fonction, pour le moment je ne gère pas du tout c'est pour cela que j'ai une fonction backup_doc et backup_bur (l'une copie tout le contenu de mon bureau et l'autre tout le contenu de mes documents)

Mais tout est bon mon script fonctionne sans problème.