Bonjour,

Je veux faire un script qui permet de parcourir les fichiers sous C:\%userprofile% et chercher les fichiers .pst afin de les déplacer vers un autre emplacement.

Src="C:\%userprofile%" ne fonctionne pas. Merci de m'aider

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
 
Option Explicit
 
 Dim fso, oFolder, WS, Ret,oSubFold,fich, Src,Dest
 
 Set fso = CreateObject("Scripting.FileSystemObject")
 Set WS = CreateObject("WScript.Shell")
 
 Src="C:\%userprofile%\"
 Dest="H:\" 
 
 Set oFolder = fso.GetFolder(src)
 CreateFolders Dest
 ScanForFile Src, Dest
' ===================================
Sub ScanForFile(srcFolder,DestFolder)
    For Each Fich In oFolder.Files
        On error resume next
	   If Ucase(fso.GetExtensionName(Fich.Name))="PST" Then
	      fso.MoveFile Fich.Path, DestFolder & "\" & fso.GetBaseName(Fich.Name) &  ".pst"
	   End If
	Next   
 
	For Each oSubFold In oFolder.SubFolders
	   For Each Fich In OsubFold.Files 
	      If Ucase(fso.GetExtensionName(Fich.Name))="PST" Then
	        fso.MoveFile Fich.Path, DestFolder & "\" & fso.GetBaseName(Fich.Name) &  ".pst"
	      End If
	   Next	  
	Next
End Sub
' =================================
Function CreateFolders(Fldr)
  Dim OldFolder, tb, I, NextFolder,Root
  If fso.FolderExists(Fldr) Then 
      CreateFolders=Fldr
	  Exit Function
  End If	  
  tb=Split(fldr,"\") 
  Root="c:\"
  On Error Resume Next
  For I=1 to Ubound(tb)
   If fso.FolderExists(Root & tb(I)) Then
      Set OldFolder=fso.GetFolder(Root & tb(I))
   ElseIf fso.FolderExists(Root & tb(I)) = False Then
      Set OldFolder=fso.GetFolder(Root)
      Set NextFolder = fso.CreateFolder(OldFolder.Path & "\" & tb(I))
   End If
   Root=NextFolder.Path & "\"
  Next
  CreateFolders=NextFolder.Path
End Function