thread329-1666328: Script to extract directory names by modified date
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.
CODE --> VBScriptconst 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! |
|
Talk To Other Members
Read More Threads Like This One