Créer une copie de test vide d’un arbre de dossiers par VbScript

Cette organisation avait mis des informations importantes dans un dossier très large contenant une quantité importante de documents approchant de plusieurs Go. Certains documents devaient être déplacés vers un dossier archive à partir de certaines caractéristiques du fichier comme l’occurrence de certains caractères dans le nom du fichier, date de création, etc.

A cette fin j’ai crée un script assez compliqué qui devrait couvrir beaucoup de situations diverses. Evidemment je ne voulais pas tester sur le dossier réel. La création d’une copie à des fins d’essai par l’utilisation de Robocopy par ex. prendrait beaucoup de temps. Ensuite utiliser cette copie pour exécuter des tests serait très lent en plus en raison de la grande taille de la copie.

Le script suivant très simple crée une copie exacte d’un arbre de dossiers mais tous les fichiers ont une taille à zéro. Tester avec ce dossier « dummy » est beaucoup plus rapide et produit des résultats très comparables.

Option Explicit
Dim sSourceRoot, sDestRoot, Msg

sSourceRoot= "C:\Temp" 
sDestRoot= "E:\Temp" 

Msg = "Create a test copy of the folder with only dummy files."

sSourceRoot = InputBox(Msg & vbCrLf & "Path source folder:",,sSourceRoot) 
sDestRoot = InputBox(Msg & vbCrLf & "Path destination folder:",,sDestRoot) 

CopyContentFolder sSourceRoot, sDestRoot
MsgBox "Finished"

Function CopyContentFolder(sPathSourceFolder,sPathDestFolder)

	Dim oFSO, oShell
	Dim fld ' as folder
	Dim fld_dest ' as folder
	Dim fc ' as folder
	Dim f ' as file
	Dim sNewPath
	Dim dDateLastModified 
	
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	Set oShell = CreateObject("Shell.Application")
	
	Set fld = oFSO.GetFolder(sPathSourceFolder)
	If Not oFSO.FolderExists(sPathDestFolder) Then
		Set fld_dest = oFSO.CreateFolder(sPathDestFolder)
	Else
		Set fld_dest = oFSO.GetFolder(sPathDestFolder)
	End If
	
	For Each f In fld.Files
		'Create dummy file in destination folder
		dDateLastModified = f.DateLastModified
		oFSO.CreateTextFile(sPathDestFolder & "\" & f.Name)
		oShell.NameSpace(sPathDestFolder).ParseName(f.Name).ModifyDate = dDateLastModified
	Next
	
	For Each fc In fld.SubFolders
		'recursive processing
		Call CopyContentFolder(fc.Path,fld_dest.Path & "\" & fc.Name)
	Next
	
End Function