Move files listed in Array

[EB176]

I have a script that at one point would search folders and present files that were designated by a date limiter. It would then simply delete these files. The new twist is that I have to now move these files to a local drive for deep archiving while maintaining their folder structure. I am a scripting novice and have attempted to use the Movefile object to no success. I am quickly running out of space so my time to tinker is growing short. I am including the original script for any suggestions.
thank you

Dim aryNameSpaces(6), strSrcDrive, strDest, intRetainDays

strSrcDrive = "D:\Shares\Archives"
intRetainDays = 397
aryNameSpaces(0) = "Prod1"
aryNameSpaces(1) = "Prod2"
aryNameSpaces(2) = "Prod3"
aryNameSpaces(3) = "Test1"
aryNameSpaces(4) = "Test2"
aryNameSpaces(5) = "Test3"
aryNameSpaces(6) = "Test4"

strYear = Year(Date)
strMonth = Month(Date)
If strMonth < 10 Then
strMonth = "0" & strMonth
End If
strDay = Day(Date)
If strDay < 10 Then
strDay = "0" & strDay
End If

Set objFSO = CreateObject("Scripting.FileSystemObject")

For Each NAMESPACE In aryNameSpaces
If objFSO.FolderExists(strSrcDrive & "\" & NAMESPACE) Then
subScanFolders NAMESPACE
End If
Next

Sub subScanFolders(NAMESPACE)
Set objSubFolders = objFSO.GetFolder(strSrcDrive & "\" & NAMESPACE).SubFolders
For Each FOLDER In objSubFolders
strFolderDate = DateSerial(Left(FOLDER.Name,4), Mid(FOLDER.Name,5,2), Right(FOLDER.Name,2))
If strFolderDate < Date - intRetainDays Then
objFSO.DeleteFolder FOLDER.Path

End If
Next
End Sub

 

[Geates]

the code supplied seems to be incomplete. I'm not sure what you are asking for.

-Geates

"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live."
- Martin Golding

 

[EB176]

This is it. Right now in it's current state this script scans a group of folders then designates all files older than x days and deletes them. I need it to grab all files older than x days and move them with the folder structure to another location.

 

[Geates]

Files or Folders?

I think what you're looking to do is create a program that will archive specific folders (hence the use of arrNameSpace) from location A to location B if they are older than intAge days and delete the original. If that is the case, here ya go.

OPTION EXPLICIT

dim arrNameSpace(6)
dim intAge
dim objFSO
dim strSourcePath
dim strArchivePath
dim strFolderName
dim strFolder

intAge = 60
strSourcePath = "D:\Downloads"
strArchivePath = "C:\Temp\Archives"

arrNameSpace(0) = "Prod1"
arrNameSpace(1) = "Prod2"
arrNameSpace(2) = "Prod3"
arrNameSpace(3) = "Test1"
arrNameSpace(4) = "Test2"
arrNameSpace(5) = "Test3"
arrNameSpace(6) = "Test4"

set objFSO = CreateObject("Scripting.FileSystemObject")

'********************************
' FUNCTIONS
'********************************

sub archiveFolder (strFolder, intAge, strDestination)
	dim objSubFolders
	dim objFolder
	
	set objSubFolders = objFSO.GetFolder(strFolder).SubFolders
	for each objFolder in objSubFolders
		if (datediff("d", objFolder.DateCreated, now) > intAge) then
			createDirectory replace(objFolder.Path, strFolder, strDestination)
			objFolder.Copy replace(objFolder.Path, strFolder, strDestination)
			objFolder.Delete
		end if
	next
end sub

sub createDirectory (strDir)
	dim strFile
	dim strParentDir
	
	strFile = right(strDir, len(strDir) - inStrRev(strDir, "\"))
	strParentDir = left(strDir, len(strDir) - len(strFile) - 1)
	
	if NOT (objFSO.FolderExists(strParentDir)) then createDirectory (strParentDir)
	objFSO.CreateFolder (strDir)
end sub

'********************************
' BEGIN
'********************************

for each strFolderName in arrNameSpace
	strFolder = strSourcePath & "\" & strFolderName
	if (objFSO.FolderExists(strFolder)) then
		archiveFolder strFolder, intAge, strArchivePath
	end if
next

-Geates

"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live."
- Martin Golding

 

[EB176]

Thank you. I have edited this to my correct paths as well as changed the date to 365 but the script is not producing any results. Any thoughts on what I may need to look at?

 

[Geates]

Make sure your paths don't contain a slash at the end. Will you post the code if it still doesn't return results?

-Geates

"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live."
- Martin Golding

 

[EB176]

As requestedBy the way how do I add the code box on this forum? I admit I did not yet read the forum rules and I assume it is there but since this site may become my new playground I will read through them tonight if I get to go home.) Thanks again!

OPTION EXPLICIT

dim arrNameSpace(6)
dim intAge
dim objFSO
dim strSourcePath
dim strArchivePath
dim strFolderName
dim strFolder

intAge = 300
strSourcePath = "D:\Shares\VTArchives"
strArchivePath = "E:\VTArchives"

arrNameSpace(0) = "01Prod"
arrNameSpace(1) = "02Prod"
arrNameSpace(2) = "04Prod"
arrNameSpace(3) = "o4Prod"
arrNameSpace(4) = "05Prod"
arrNameSpace(5) = "Vision"
arrNameSpace(6) = "03Prod"

set objFSO = CreateObject("Scripting.FileSystemObject")

'********************************
' FUNCTIONS
'********************************

sub archiveFolder (strFolder, intAge, strDestination)
dim objSubFolders
dim objFolder

set objSubFolders = objFSO.GetFolder(strFolder).SubFolders
for each objFolder in objSubFolders
if (datediff("d", objFolder.DateCreated, now) > intAge) then
createDirectory replace(objFolder.Path, strFolder, strDestination)
objFolder.Copy replace(objFolder.Path, strFolder, strDestination)
objFolder.Delete
end if
next
end sub

sub createDirectory (strDir)
dim strFile
dim strParentDir

strFile = right(strDir, len(strDir) - inStrRev(strDir, "\"))
strParentDir = left(strDir, len(strDir) - len(strFile) - 1)

if NOT (objFSO.FolderExists(strParentDir)) then createDirectory (strParentDir)
objFSO.CreateFolder (strDir)
end sub

'********************************
' BEGIN
'********************************

for each strFolderName in arrNameSpace
strFolder = strSourcePath & "\" & strFolderName
if (objFSO.FolderExists(strFolder)) then
archiveFolder strFolder, intAge, strArchivePath
end if
next

 

[Geates]

Read the "Process TGML" link in "Step 2: Options" of the reply form below.

Everything looks right. I would throw in a few msgbox's to whats going on.

for each strFolderName in arrNameSpace
    strFolder = strSourcePath & "\" & strFolderName
    [red]msgbox "Checking: " & strFolder [/red]    
    if (objFSO.FolderExists(strFolder)) then
        [red]msgbox "Folder Exists"[/red]
        archiveFolder strFolder, intAge, strArchivePath
    end if
next

-Geates



"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live."
- Martin Golding

 

[EB176]

Ok so all the sources ckeck out ok and yet no file movement. I thought maybe I was cutting it out early so I let it run and actually saw wscript end on it's own. I know I have files in these paths that meet the criteria. How many levels will this go down? From the source I am three levels deeper before we meet the actual files. Could this be an issue? I think I remember it causing problems when I initially set this up?

 

[Geates]

WScript ending on it's own does not mean that the script ran as intended. It only suggests that the script executed. [red]I would recommend using msgbox's to check for integrity[/red]

This script doesn't act on any files and it is not recursive (as per what your initial code suggested). If strSource & "\" & strNameSpace exists, then move any sub folder old than intAge.

What exactly are you trying to achieve?

-Geates

"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live."
- Martin Golding

 

[EB176]

Ok I will dig through it again tonight. I am attempting to dig through the loder lists and designate files that are older than X days then move them (voice recordings *.MP3) files off of the active system and to a location where we could later retreive them if necessary.

 

[Geates]

Ah. You want to move Files older than x days, not folders. In that case, archiveFolder needs to be recursive. A recursive function is one that calls itself. In this case, it would discover sub folders within sub folders within sub folders...etc

Notice that the function name has changed to "archiveFiles". Also, notice, that it calls itself when it encounters a sub folder. And keeps doing it until there are no more sub folders. Then the function processes the files that are older than x days.

sub archiveFiles (strFolder, intAge, strDestination)
	dim objSubFolders
	dim objFolder
	dim objFiles
	dim objFile
	
	set objSubFolders = objFSO.GetFolder(strFolder).SubFolders
	for each objFolder in objSubFolders
		[red]archiveFiles objFolder.Path, intAge, strDestination & "\" & objFolder.Name[/red]
	next
	
	set objFiles = objFSO.GetFolder(strFolder).Files
	for each objFile in objFiles
		if (datediff("d", objFile.DateCreated, now) > intAge) then
			createDirectory replace(objFSO.GetParentFolderName(objFile.Path), strFolder, strDestination)
			objFile.Copy replace(objFile.Path, strFolder, strDestination)
			objFolder.Delete
		end if
	next
end sub

-Geates

"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live."
- Martin Golding

 

[EB176]

Ok. Anychance you would be willing to put it all back together for me based on your initial suggestion?

 

[Geates]

All the code you need is in this thread. Even a novice should be able to figure it out. It's quite simple. Replace the SUB archiveFolders code with that of archiveFiles. And, any instance of the call.

OPTION EXPLICIT

dim arrNameSpace(6)
dim intAge
dim objFSO
dim strSourcePath
dim strArchivePath
dim strFolderName
dim strFolder

intAge = 10

strSourcePath = "D:\Downloads"
strArchivePath = "C:\Temp\Archives"

arrNameSpace(0) = "Prod2"
arrNameSpace(1) = "Prod3"
arrNameSpace(2) = "TekTips"
arrNameSpace(3) = "Test1"
arrNameSpace(4) = "Test2"
arrNameSpace(5) = "Test3"
arrNameSpace(6) = "Test4"

set objFSO = CreateObject("Scripting.FileSystemObject")

'***************************
' FUNCTIONS
'***************************

[red]
sub archiveFiles (strFolder, intAge, strDestination)
	dim objSubFolders
	dim objFolder
	dim objFiles
	dim objFile
	
	set objSubFolders = objFSO.GetFolder(strFolder).SubFolders
	for each objFolder in objSubFolders
		archiveFiles objFolder.Path, intAge, strDestination & "\" & objFolder.Name
	next
	
	set objFiles = objFSO.GetFolder(strFolder).Files
	for each objFile in objFiles
		if (datediff("d", objFile.DateCreated, now) > intAge) then
			createDirectory replace(objFSO.GetParentFolderName(objFile.Path), strFolder, strDestination)
			objFile.Copy replace(objFile.Path, strFolder, strDestination)
			objFolder.Delete
		end if
	next
end sub
[/red]
sub createDirectory (strDir)
	on error resume next
	dim strFile
	dim strParentDir
	
	strFile = right(strDir, len(strDir) - inStrRev(strDir, "\"))
	strParentDir = left(strDir, len(strDir) - len(strFile) - 1)
	
	if NOT (objFSO.FolderExists(strParentDir)) then createDirectory (strParentDir)
	objFSO.CreateFolder (strDir)
end sub

'***************************
' BEGIN
'***************************

for each strFolderName in arrNameSpace
	strFolder = strSourcePath & "\" & strFolderName
	if (objFSO.FolderExists(strFolder)) then
		[red]archiveFiles[/red] strFolder, intAge, strArchivePath
	end if
next

-Geates


"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live."
- Martin Golding