[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 522
  • Last Modified:

Check files DateLastModified only in First Level SubFolders

I am fairly new to vbscript, but learning every day. I need a vbscript that will check only in the first level subfolder from the root folder. Then it checks the DateLastModified on all files in that folder. If a file meets criteria, then copy (or preferably move) that folder (and its contents) to another folder. I have the following code, but it checks All Subfolders.
Set objFSO = CreateObject("Scripting.FileSystemObject")
objRootFolder = "W:\CasesT"
Set objFolder = objFSO.GetFolder(objRootFolder)
ShowSubfolders objFSO.GetFolder(objRootFolder)
Sub ShowSubFolders(Folder)
    For Each Subfolder in Folder.SubFolders
        Set objFolder = objFSO.GetFolder(folder.Path)
        Set colFiles = objFolder.Files
  	a = 0
    For Each objFile in colFiles
	dtmDate = objFile.DateLastModified
	fileDate = DateDiff("m", dtmDate, Date)
	If fileDate < 1 Then
	a = 1
	Exit For
	End If
        Next
	If a = 1 Then
	objFSO.CopyFolder objFolder.Path , "W:\Cases2\"
	End If
        ShowSubFolders Subfolder
    Next
End Sub

Open in new window

0
usdcaz
Asked:
usdcaz
1 Solution
 
Shift-3Commented:
This should do it.


strSource = "W:\CasesT"
strDest = "W:\Cases2"
intMonths = 1
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strSource)
 
For Each objSubfolder in objFolder.SubFolders
    For Each objFile in objSubfolder.Files
        dtmDate = objFile.DateLastModified
        
        If DateDiff("m", dtmDate, Date) < intMonths Then
            objFSO.CopyFolder objSubfolder.Path, strDest & "\"
            Exit For
        End If
    Next
Next

Open in new window

0
 
usdcazSystems Technology Division ManagerAuthor Commented:
Great, worked perfectly! Thanks you for your help!
0

Featured Post

The 14th Annual Expert Award Winners

The results are in! Meet the top members of our 2017 Expert Awards. Congratulations to all who qualified!

Tackle projects and never again get stuck behind a technical roadblock.
Join Now