BvSiT

Creating an empty test copy of a directory tree with VbScript

This organization had important information in a very large folder with a huge number of documents up to several GB. Some documents had to be moved to an archive folder based on certain characteristics of the file like occurrence of certain characters in the name of the file, creation date, etc.

To achieve this I created a rather complicated VBscript that had to cover many different situations. Of course I did not want to test this on the original folder. To make a simple copy for testing purposes by using i.e. Robocopy would take a long time. Then using this copy for running tests would also be very slow due to its large size.

The following very simple script makes an exact copy of a directory tree but all files have zero length. So the size of the total folder tree is also exactly zero. Testing on this "dummy" folder is much faster while generating very comparable results as when using the original folder tree.

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