Moving files based on DateLastModified

[Onenguyen]

thread329-1666328

I just want to say that I love this forum and I have learned so much from just browsing.

I have a script that I am using from a previous thread and I need some assistance with modifying it to suit my needs.

1) I need the script to move instead of copy. When I change the objFolder.Copy to objFolder.Move the error file says it was unable to move folder. Is this because of Permissions?

2) I am attempting to run this script on a VERY big set of folders (Close to 2TB). I had it running overnight and nothing had been accomplished. Is this because it has to find the documents before it starts copying, thus making it very time consuming? Is there anyway to clean up or modify the script so it doesn't take so long? I tried it on a smaller subset (60gb) and it still takes a long time for it to start.

const ForAppending = 8
set objFSO = CreateObject("Scripting.FileSystemObject")
set objShell = CreateObject("WScript.Shell")
set objTextFile = objFSO.OpenTextFile ("L:\env4\LOG.log", ForAppending, True)

function findRecentFile(strDir, strRecent)  
    dim objFolder  
    set objFolder = objFSO.GetFolder(strDir)
    for each objSubFolder in objFolder.SubFolders
        strRecent = findRecentFile(objSubFolder.Path, strRecent)
        'strLog = strLog & findRecentFile(objSubFolder.Path, intAge)
    next

    for each objFile in objFolder.Files
        if (strRecent = "") then
             strRecent = objFile.Path
        else
            if (objFile.DateLastModified > objFSO.GetFile(strRecent).DateLastModified) then strRecent = objFile.Path
        end if
    next
    findRecentFile = strRecent
end function

intAge = 90 '3 months
strSource = "L:\env4\12025_0009"
strDestination = "D:\12025_0009\"

'strLog = findRecentFile(strSource, intAge)

'Header = "Folder | Last Date Modified | Last Date Accessed"
'objTextFile.WriteLine(Header)
'objTextFile.WriteLine(strLog)
'objTextFile.Close

for each objFolder in objFSO.GetFolder(strSource).SubFolders
    strFile = findRecentFile(objFolder.Path, "")
    if (strFile <> "") then
        strModDate = objFSO.GetFile(strFile).DateLastModified
        strProjectFolder = objFSO.GetParentFolderName(strFile)
    else
        strModDate = objFolder.DateLastModified
        strProjectFolder = objFolder.Name
    end if
    if (datediff("d", strModDate, now) > intAge) then
    	On Error Resume Next
    	Err.Clear
        objFolder.Copy strDestination & objFolder.Name
        If Err.Number <> 0 Then
        	objTextFile.WriteLine(objFolder.Path & vbTab & "Folder was not transferred")
        else
        	objTextFile.WriteLine(objFolder.Path & vbTab & "Folder successfully transferred")
        
        end if
	 	  
       end if     
    
next

Thank you!

 

[Onenguyen]

One more quick questions. Is there a way to make it so that if the folder doesn't exist, it creates it automatically?

strDestination = "D:\12025_0009\"

I want it to be able to create the top level parent folder.

Thanks!!