'-----------------------------------------------------------------------------------
' A recursive function to move all files (include sub-folders) from a source folder
' to a target folder, which are older than a certain days from today
'-----------------------------------------------------------------------------------
Const strSourceFolder = "\\machine A\direcotrypath"
Const strTargetFolder = "\\machine B\direcotrypath"
Const intDaysToKeep = 30
strCurrentFolder = strSourceFolder
Call MoveFolder(strCurrentFolder, intDaysToKeep)
msgbox "done"
Sub MoveFolder(strCurrentFolder, intDaysToKeep)
Dim objFSO, objCurrentFolder
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objCurrentFolder = objFSO.GetFolder(strCurrentFolder)
Dim objFile, objFolder
For Each objFile In objCurrentFolder.Files
If DateDiff("d", objFile.DateLastModified, Now) > intDaysToKeep Then
strTargetPath = Replace(UCase(objFSO.GetParentFolderName(objFile)), UCase(strSourceFolder), strTargetFolder, 1)
If Not objFSO.FolderExists(strTargetPath) Then objFSO.CreateFolder(strTargetPath)
objFSO.MoveFile objFile, strTargetPath & "\" & objFSO.GetFileName(objFile)
End If
Next
For Each objFolder In objCurrentFolder.subFolders
Call MoveFolder(objFolder, intDaysToKeep)
Next
End Sub
|