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
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
| Option Explicit
' Flags for the options parameter
Const BIF_returnonlyfsdirs = &H0001
Const BIF_dontgobelowdomain = &H0002
Const BIF_statustext = &H0004
Const BIF_returnfsancestors = &H0008
Const BIF_editbox = &H0010
Const BIF_validate = &H0020
Const BIF_browseforcomputer = &H1000
Const BIF_browseforprinter = &H2000
Const BIF_browseincludefiles = &H4000
Const OverwriteExisting = TRUE
Dim wsh, objDlg, objF
Dim FSO, objFolder
Const VAR_Favoris = 0
Const VAR_Desktop = 1
Const VAR_Docs = 2
Const VAR_NotesData = 3
Const VAR_NotesArchives = 4
Const VAR_NotesReplMail = 5
Const VAR_NotesReplApps = 6
Const TYP_Origine = 0
Const TYP_Destination = 1
Dim aPath(7,2) ' Tableau de stockage des chemins Origine et destination
Dim cCopy, cDisplayMsg
Dim source
' Initialisation des chemins de destination
set wsh = CreateObject("WScript.Shell")
aPath(Var_Favoris, TYP_Destination) = wsh.SpecialFolders("Favorites")
aPath(Var_Desktop, TYP_Destination) = wsh.SpecialFolders("Desktop")
aPath(Var_Docs, TYP_Destination) = wsh.SpecialFolders("MyDocuments")
aPath(Var_Docs, TYP_Destination) = "d:\MyDocs"
aPath(Var_NotesData, TYP_Destination) = "d:\CommonUserData\LotusNotesData"
aPath(Var_NotesArchives, TYP_Destination) = "d:\CommonUserData\LotusNotesData\Archives"
aPath(Var_NotesReplMail, TYP_Destination) = "d:\CommonUserData\LotusNotesData\Mail"
aPath(Var_NotesReplApps, TYP_Destination) = "d:\CommonUserData\LotusNotesData\Apps"
' Je passe à la saisie des chemins d'origine
' Favoris Internet
aPath( VAR_Favoris, TYP_Origine ) = FALSE
source = BrowseForFolder( _
"Sélectionner le dossier des favoris de l'utilisateur", _
BIF_editbox + BIF_returnonlyfsdirs, _
"")
If source = "-5" Then
WScript.Echo "Impossible de choisir des fichiers à la racine"
Else
If source = "-1" Then
'WScript.Echo "No object selected; Cancel clicked"
Else
'WScript.Echo "Object: ", source
aPath( VAR_Favoris, TYP_Origine ) = source
End If
End If
' Bureau
aPath( VAR_Desktop, TYP_Origine ) = FALSE
source = BrowseForFolder( _
"Sélectionner le bureau d'origine de l'utilisateur", _
BIF_editbox + BIF_returnonlyfsdirs, _
"")
If source = "-5" Then
WScript.Echo "Impossible de choisir des fichiers à la racine"
Else
If source = "-1" Then
'WScript.Echo "No object selected; Cancel clicked"
Else
'WScript.Echo "Object: ", source
aPath( VAR_Desktop, TYP_Origine ) = source
End If
End If
' Documents de l'utilisateur
aPath( VAR_Docs, TYP_Origine ) = FALSE
source = BrowseForFolder( _
"Sélectionner le dossier contenant les documents de l'utilisateur", _
BIF_editbox + BIF_returnonlyfsdirs, _
"")
If source = "-5" Then
WScript.Echo "Impossible de choisir des fichiers à la racine"
Else
If source = "-1" Then
'WScript.Echo "No object selected; Cancel clicked"
Else
'WScript.Echo "Object: ", source
aPath( VAR_Docs, TYP_Origine ) = source
End If
End If
'-----------------------------------------------------------------------------
' Spécial Lotus Notes
'-----------------------------------------------------------------------------
' Différentes natures de fichiers/répertoires
' les fichiers à sauvegarder sont:
' NOTES.INI --> dans c:\PF\Lotus\Notes\
' BOOKMARK.NSF --> dans Notes\Data
' DESKTOP6.NDK --> dans Notes\Data
' NAMES.NSF --> dans Notes\Data
' Les fichiers .ID --> dans Notes\Data
' Les bases locales (*.NSF) : Mail ou Apps --> certainement dans Data
' Configuration Notes
' Sélection du répertoire Notes d'origine
aPath( VAR_NotesData, TYP_Origine ) = FALSE
source = BrowseForFolder( _
"Sélectionner le dossier DATA de Lotus Notes d'origine", _
BIF_editbox + BIF_returnonlyfsdirs, _
"")
If source = "-5" Then
WScript.Echo "Impossible de choisir des fichiers à la racine"
Else
If source = "-1" Then
'WScript.Echo "No object selected; Cancel clicked"
Else
'WScript.Echo "Object: ", source
aPath( VAR_NotesData, TYP_Origine ) = source
End If
End If
' Archives Notes
' Sélection du répertoire des archives Notes d'origine
aPath( VAR_NotesArchives, TYP_Origine ) = FALSE
source = BrowseForFolder( "Sélectionner le dossier ou le fichier contenant les archives" & vbCRLF & _
"Si les archives sont seules dans un dossier, sélectionnez le dossier" & vbCRLF & _
"Si les archives sont dans \Notes\Data, sélectionnez le fichier", _
BIF_editbox + BIF_returnonlyfsdirs, _
"")
If source = "-5" Then
WScript.Echo "Impossible de choisir des fichiers à la racine"
Else
If source = "-1" Then
'WScript.Echo "No object selected; Cancel clicked"
Else
'WScript.Echo "Object: ", source
aPath( VAR_NotesArchives, TYP_Origine ) = source
End If
End If
' Notes ==> Sélection du répertoire contenant des répliques locales
' Sélection de la réplique mail local
aPath( VAR_NotesReplMail, TYP_Origine ) = FALSE
source = BrowseForFolder( _
"Sélectionner la réplique locale de la base mail, ou le dossier la contenant" & vbCRLF & _
"Si la réplique locale est seule dans un dossier, sélectionnez le dossier" & vbCRLF & _
"Si elle est directement dans \Notes\Data, sélectionnez le fichier", _
BIF_editbox + BIF_returnonlyfsdirs, _
"")
If source = "-5" Then
WScript.Echo "Impossible de choisir des fichiers à la racine"
Else
If source = "-1" Then
'WScript.Echo "No object selected; Cancel clicked"
Else
'WScript.Echo "Object: ", source
aPath( VAR_NotesReplMail, TYP_Origine ) = source
End If
End If
' Sélection des répliques d'application (MP3 par exemple)
aPath( VAR_NotesReplApps, TYP_Origine ) = FALSE
source = BrowseForFolder( _
"Sélectionner la réplique Notes locale de l'application, ou le dossier la contenant" & vbCRLF & _
"Si la réplique locale est seule dans un dossier, sélectionnez le dossier" & vbCRLF & _
"Si elle est directement dans \Notes\Data, sélectionnez le fichier", _
BIF_editbox + BIF_returnonlyfsdirs, _
"")
If source = "-5" Then
WScript.Echo "Impossible de choisir des fichiers à la racine"
Else
If source = "-1" Then
'WScript.Echo "No object selected; Cancel clicked"
Else
'WScript.Echo "Object: ", source
aPath( VAR_NotesReplApps, TYP_Origine ) = source
End If
End If
' Phase de copie
' J'affiche ce que je vais faire
cDisplayMsg = "Les tâches suivantes vont être réalisées:" & vbCRLF
cDisplayMsg = cDisplayMsg & "-----------------------------------------" & vbCRLF
If aPath(VAR_Favoris, TYP_Origine) <> FALSE Then
cDisplayMsg = cDisplayMsg & "--> Copie de " & aPath(VAR_Favoris, TYP_Origine) _
& " vers " & aPath(VAR_Favoris, TYP_Destination) & vbCRLF & vbCRLF
End If
If aPath(VAR_Desktop, TYP_Origine) <> FALSE Then
cDisplayMsg = cDisplayMsg & "--> Copie de " & aPath(VAR_Desktop, TYP_Origine) _
& " vers " & aPath(VAR_Desktop, TYP_Destination) & vbCRLF & vbCRLF
End If
If aPath(VAR_Docs, TYP_Origine) <> FALSE Then
cDisplayMsg = cDisplayMsg & "--> Copie de " & aPath(VAR_Docs, TYP_Origine) _
& " vers " & aPath(VAR_Docs, TYP_Destination) & vbCRLF & vbCRLF
End If
If aPath(VAR_NotesData, TYP_Origine) <> FALSE Then
cDisplayMsg = cDisplayMsg & "--> Copie de DESKTOP6.NDK, NAMES.NSF, BOOKMARK.NSF et des fichiers ID de " & vbCRLF & _
" " & aPath(VAR_NotesData, TYP_Origine) & " vers " & aPath(VAR_NotesData, TYP_Destination) & vbCRLF & vbCRLF
End If
If aPath(VAR_NotesArchives, TYP_Origine) <> FALSE Then
cDisplayMsg = cDisplayMsg & "--> Copie de " & aPath(VAR_NotesArchives, TYP_Origine) _
& " vers " & aPath(VAR_NotesArchives, TYP_Destination) & vbCRLF & vbCRLF
End If
If aPath(VAR_NotesReplMail, TYP_Origine) <> FALSE Then
cDisplayMsg = cDisplayMsg & "--> Copie de " & aPath(VAR_NotesReplMail, TYP_Origine) _
& " vers " & aPath(VAR_NotesReplMail, TYP_Destination) & vbCRLF & vbCRLF
End If
If aPath(VAR_NotesReplApps, TYP_Origine) <> FALSE Then
cDisplayMsg = cDisplayMsg & "--> Copie de " & aPath(VAR_NotesReplApps, TYP_Origine) _
& " vers " & aPath(VAR_NotesReplApps, TYP_Destination) & vbCRLF & vbCRLF
End If
' Validation
If MsgBox( cDisplayMsg,vbQuestion + vbYesNo + vbApplicationModal + 0,"Attention !!!" ) = vbNo Then
Wscript.echo "Abandon de la copie"
Wscript.Quit
End If
' C'est Ok --> Je lance...
cDisplayMsg = ""
' - Mes documents (données entreprises)
If aPath(VAR_Docs, TYP_Origine) <> FALSE Then
cCopy = chr(34) & aPath(VAR_Docs, TYP_Origine) & chr(34) & " " & chr(34) & aPath(VAR_Docs, TYP_Destination) & chr(34)
set wsh = WScript.CreateObject("WScript.Shell")
wsh.Run( "C:\WINDOWS\XcopyEx.exe " & cCopy )
cDisplayMsg = cDisplayMsg & "Copie Mes Documents lancée..." & vbCRLF
End If
' - Lotus Notes (bureau, carnet d’adresses personnel, archives)
If aPath(VAR_NotesData, TYP_Origine) <> FALSE Then
' La copie est faite via les méthodes de vb, car les fichiers sont connus et pas très gros
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CopyFile aPath(VAR_NotesData, TYP_Origine) & "\Desktop6.ndk" , aPath(VAR_NotesData, TYP_Destination) & "\" , OverwriteExisting
FSO.CopyFile aPath(VAR_NotesData, TYP_Origine) & "\Names.nsf" , aPath(VAR_NotesData, TYP_Destination) & "\" , OverwriteExisting
FSO.CopyFile aPath(VAR_NotesData, TYP_Origine) & "\Bookmark.nsf" , aPath(VAR_NotesData, TYP_Destination) & "\" , OverwriteExisting
FSO.CopyFile aPath(VAR_NotesData, TYP_Origine) & "\*.id" , aPath(VAR_NotesData, TYP_Destination) & "\" , OverwriteExisting
Set FSO = Nothing
cDisplayMsg = cDisplayMsg & "Copie Données de configuration Notes lancée..." & vbCRLF
End If
' Les archives Notes
If aPath(VAR_NotesArchives, TYP_Origine) <> FALSE Then
' Je dois d'abord vérifier l'existence du dossier Archives sur la destination
If CheckFileFolderExists( aPath(VAR_NotesArchives, TYP_Destination), False ) = False Then
' Il n'existe pas ==> Je le créée
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.CreateFolder(aPath(VAR_NotesArchives, TYP_Destination))
Set FSO = Nothing
End If
cCopy = chr(34) & aPath(VAR_NotesArchives, TYP_Origine) & chr(34) & " " & chr(34) & aPath(VAR_NotesArchives, TYP_Destination) & chr(34)
set wsh = WScript.CreateObject("WScript.Shell")
wsh.Run( "C:\WINDOWS\XcopyEx.exe " & cCopy )
cDisplayMsg = cDisplayMsg & "Copie Archives Notes lancée..." & vbCRLF & _
"Pensez à faire pointer l'archivage vers le répertoire archives..."
End If
' Les répliques locales (Mail, puis Applications)
If aPath(VAR_NotesReplMail, TYP_Origine) <> FALSE Then
' Je dois d'abord vérifier l'existence du dossier Mail sur la destination
If CheckFileFolderExists( aPath(VAR_NotesReplMail, TYP_Destination), False ) = False Then
' Il n'existe pas ==> Je le créée
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.CreateFolder(aPath(VAR_NotesReplMail, TYP_Destination))
Set FSO = Nothing
End If
cCopy = chr(34) & aPath(VAR_NotesReplMail, TYP_Origine) & chr(34) & " " & chr(34) & aPath(VAR_NotesReplMail, TYP_Destination) & chr(34)
set wsh = WScript.CreateObject("WScript.Shell")
wsh.Run( "C:\WINDOWS\XcopyEx.exe " & cCopy )
cDisplayMsg = cDisplayMsg & "Copie Réplique locale de la messagerie Notes lancée..." & vbCRLF & _
"Pensez à faire pointer la réplique dans les documents de site vers le répertoire Mail..."
End If
If aPath(VAR_NotesReplApps, TYP_Origine) <> FALSE Then
' Je dois d'abord vérifier l'existence du dossier Apps sur la destination
If CheckFileFolderExists( aPath(VAR_NotesReplApps, TYP_Destination), False ) = False Then
' Il n'existe pas ==> Je le créée
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.CreateFolder(aPath(VAR_NotesReplApps, TYP_Destination))
Set FSO = Nothing
End If
cCopy = chr(34) & aPath(VAR_NotesReplApps, TYP_Origine) & chr(34) & " " & chr(34) & aPath(VAR_NotesReplApps, TYP_Destination) & chr(34)
set wsh = WScript.CreateObject("WScript.Shell")
wsh.Run( "C:\WINDOWS\XcopyEx.exe " & cCopy )
cDisplayMsg = cDisplayMsg & "Copie Réplique locale des applications Notes lancée..." & vbCRLF
End If
' - Favoris Internet Explorer
If aPath(VAR_Favoris, TYP_Origine) <> FALSE Then
cCopy = chr(34) & aPath(VAR_Favoris, TYP_Origine) & chr(34) & " " & chr(34) & aPath(VAR_Favoris, TYP_Destination) & chr(34)
set wsh = WScript.CreateObject("WScript.Shell")
wsh.Run( "C:\WINDOWS\XcopyEx.exe " & cCopy )
cDisplayMsg = cDisplayMsg & "Copie Favoris Internet Explorer lancée..." & vbCRLF
End If
' - Documents IW/DM local ==> Sauvegardés via export vers Mes docs
' - Les raccourcis (Bureau Canon)
If aPath(VAR_Desktop, TYP_Origine) <> FALSE Then
cCopy = chr(34) & aPath(VAR_Desktop, TYP_Origine) & chr(34) & " " & chr(34) & aPath(VAR_Desktop, TYP_Destination) & chr(34)
set wsh = WScript.CreateObject("WScript.Shell")
wsh.Run( "C:\WINDOWS\XcopyEx.exe " & cCopy )
cDisplayMsg = cDisplayMsg & "Copie Bureau lancée..." & vbCRLF
End If
Function IsValue(obj)
' Check whether the value has been returned.
Dim tmp
On Error Resume Next
tmp = " " & obj
If Err <> 0 Then
IsValue = False
Else
IsValue = True
End If
On Error GoTo 0
End Function
MsgBox cDisplayMSg,vbInformation + vbOkOnly + vbApplicationModal + 0,"Bilan des opérations"
set wsh = nothing
' Using the shell's BrowseForFolder method to
' return the full path to the selected object
' title = Text shown in the dialog box
' flag = One of the values for controlling the
' BrowseForFolder behavior
' dir = Preselected directory (can be "")
Function BrowseForFolder(title, flag, dir)
On Error Resume Next
Dim oShell, oItem, tmp
' Create WshShell object.
Set oShell = WScript.CreateObject("Shell.Application")
' Invoke Browse For Folder dialog box.
Set oItem = oShell.BrowseForFolder(&H0, title, flag, dir)
If Err.Number <> 0 Then
If Err.Number = 5 Then
BrowseForFolder= "-5"
Err.Clear
Set oShell = Nothing
Set oItem = Nothing
Exit Function
End If
End If
' Now we try to retrieve the full path.
BrowseForFolder = oItem.ParentFolder.ParseName(oItem.Title).Path
' Handling: Cancel button and selecting a drive
If Err<> 0 Then
If Err.Number = 424 Then ' Handle Cancel button.
BrowseForFolder = "-1"
Else
Err.Clear
' Handle situation in which user selects a drive.
' Extract drive letter from the title--first search
' for a colon (:).
tmp = InStr(1, oItem.Title, ":")
If tmp > 0 Then ' A : is found; use two
' characters and add \.
BrowseForFolder = _
Mid(oItem.Title, (tmp - 1), 2) & "\"
End If
End If
End If
Set oShell = Nothing
Set oItem = Nothing
On Error GoTo 0
End Function
Function CheckFileFolderExists(strName, fFile)
' The fFile variable determines whether you're
' looking for a File (True) or Folder(False)
' The strName variable holds the fully qualified
' path you're looking for
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
CheckFileFolderExists = False
If fFile = True Then ' It's a file
If fso.FileExists(strName) = True Then
CheckFileFolderExists = True
Exit Function
End If
Else ' It's a folder/directory
If fso.FolderExists(strName) = True Then
CheckFileFolderExists = True
Exit Function
End if
End If
Set fso = Nothing
End Function |
copie de fichiers à destination connue avec BrowseForFolder et XCopyEx
Répondre avec citation
Partager