Hi, I'm looking fo a bit of help in finishing the code below please. It is to be used to archive files that are older than AND not accessed after a given date. It differs from most internet scripts in that the archive folder is located within the folder being searched for 'old' files and I'm trying to retain the folder structure. I'm using a test location of C:\Temp with some test files,and sub folders in for this debug. First part seems to work fine the archive folder is created and files from the topmost folder are moved here (in the code I have copied these files for testing purposes). Sub folder search kicks in and creates the first folder but then the script dies because the PATH3 variable becomes incorrect. Can anyone help with the subfolder search ??
'-----------------start of code
Option Explicit
'set variables
Dim strDte, strShare, PATH, PATH0, PATH1, PATH2, PATH3
Dim fso, objFolder, colFiles, objFile, strFile
Dim Int1, Subfolder
'initialise
PATH = "C:\Temp"
Set fso = CreateObject("Scripting.FileSystemObject")
Int1 = 0
'call the required input from the user
strDte = InputBox("Date", "DATE", Date)
'check the target path and report if it is not found
If fso.FolderExists(PATH) Then
Set objFolder = fso.GetFolder(PATH)
Set colFiles = objFolder.Files
Else
Wscript.Echo "Can't find the " & PATH & " folder"
Wscript.Quit
End if
'check the resultant path and create it if it is not found
PATH1 = PATH & "\Archive files before " & Replace(strDte,"/","")
If fso.FolderExists(PATH1) Then
Else
Set objFolder = FSO.CreateFolder(PATH1)
End if
'append a backslash so we can move files into the folder
PATH1 = PATH1 & "\"
'move files that were modiefied AND last accessed before the chosen date (strDte)
' in the PATH folder
For Each strFile in colFiles
Set objFile = fso.GetFile(strFile)
If DateDiff("d", objFile.DateLastModified, strDte) <= 0 Then
If DateDiff("d", objFile.DateLastAccessed, strDte) <= 0 Then
'wscript.echo objFile.Path
fso.CopyFile strFile, PATH1, True
Int1 = Int1 + 1
End If
Else
End if
Set objFile = Nothing
Next
' now lets look at the sub folders
ShowSubfolders FSO.GetFolder(PATH)
'remove the backslash from the end of the archive folder
PATH1 = left(PATH1,len(PATH1) - 1)
'report to user
Wscript.Echo Int1 & " files moved to " & PATH1 & " Folder"
Wscript.Quit
Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
Set objFolder = fso.GetFolder(Subfolder.Path)
If InStr(objfolder,"Archive") = 0 then
Set colFiles = objFolder.Files
For Each strFile in colFiles
Set objFile = fso.GetFile(strFile)
If DateDiff("d", objFile.DateLastModified, strDte) <= 0 Then
If DateDiff("d", objFile.DateLastAccessed, strDte) <= 0 Then
Path2 = Path & Right(objFile.ParentFolder,len(objFile.ParentFolder)- Len(path)) & "\"
Path3 = PATH1 & mid(objFolder,len(PATH) +2, len(objFolder))
If fso.FolderExists(PATH3) Then
'copy file
'fso.CopyFile strFile, PATH3, True
Int1 = Int1 + 1 'increment counter
Else
wscript.echo strFile & vbcrlf & path3
'create folder
Set objFolder = FSO.CreateFolder(PATH3)
'copy file
'fso.CopyFile strFile, PATH3, True
Int1 = Int1 + 1 'increment counter
End if
Else
'date last access faild validation
End If
Else
'date last modified fails validation
End if
Set objFile = Nothing
Next
End if
ShowSubFolders Subfolder
Next
End Sub
'---------------------- end of code
D Stead