Recursively copy files from sub-folders based on date-stamp and file type

Hi all,

I had a previous question where I needed to search a single folder for the 3 latest files in that folder then copy those 3 files to a new folder - this question got answered and the thread can be found here:

https://stackoverflow.com/questions/48866113/identify-and-copy-latest-files-in-directory

The next issue I have now is:

1) I have a main folder with 20 sub-folders

2) Everyday around 7AM, a new csv extract is added to each sub-folder

2) I need to search through each individual sub-folder and find the latest (the current days) file added to that sub-folder

3) I then need to copy each individual file from its respective sub-folder and place ALL the files in ONE folder - there's no chance of the filenames ever being the same

I found 2 solutions that work in their own way, but I need to "combine" the solutions.

Solution 1: This one will copy ALL files found in a single directory based on the current date to a separate folder

Option Explicit

Dim FolderToCheck, FolderDestination, FileExt, mostRecent, noFiles, fso, fileList, file, filecounter, oShell, strHomeFolder

' Enumerate current user's home path - we will use that by default later if nothing specified in commandline
Set oShell = CreateObject("WScript.Shell")
strHomeFolder = oShell.ExpandEnvironmentStrings("%USERPROFILE%")

'Variables -----
folderToCheck = strHomeFolder & "\Desktop\Terminations"           ' Folder Source to check for recent files to copy FROM
folderDestination = strHomeFolder & "\Desktop\Terminations\Sorted"          ' Destination Folder where to copy files TO

fileExt = "csv"     ' Extension we are searching for
mostRecent = 3      ' Most Recent number of files to copy
' --------------


PreProcessing()     ' Retrieve Command Line Parameters

' Display what we are intending on doing
wscript.echo "Checking Source: " & FolderToCheck 
wscript.echo "For Files of type: " & FileExt
wscript.echo "Copying most recent "& mostRecent &" file(s) to: " & FolderDestination & "."

noFiles = TRUE

Set fso = CreateObject("Scripting.FileSystemObject")

Set fileList = CreateObject("ADOR.Recordset")
fileList.Fields.append "name", 200, 255
fileList.Fields.Append "date", 7
fileList.Open

If fso.FolderExists(FolderToCheck) Then 
    For Each file In fso.GetFolder(FolderToCheck).files
     If LCase(fso.GetExtensionName(file)) = LCase(FileExt) then
       fileList.AddNew
       fileList("name").Value = File.Path
       fileList("date").Value = File.DateLastModified
       fileList.Update
       If noFiles Then noFiles = FALSE
     End If
    Next
    If Not(noFiles) Then 
        wscript.echo fileList.recordCount & " File(s) found. Sorting and copying last " & mostRecent &"..."
        fileList.Sort = "date DESC"
        If Not(fileList.EOF) Then 
            fileList.MoveFirst
            If fileList.recordCount < mostRecent Then 
                wscript.echo "WARNING: " & mostRecent &" file(s) specified but only " & fileList.recordcount & " file(s) match criteria. Adjusted to " & fileList.RecordCount & "."
                mostRecent = fileList.recordcount
            End If

            fileCounter = 0
            Do Until fileList.EOF Or fileCounter => mostRecent
                If Not(fso.FolderExists(folderDestination)) Then 
                    wscript.echo "Destination Folder did not exist. Creating..."
                    fso.createFolder folderDestination
                End If
                fso.copyfile fileList("name"), folderDestination & "\", True
                wscript.echo  fileList("date").value & vbTab & fileList("name")
                fileList.moveNext
                fileCounter = fileCounter + 1
            Loop
        Else
            wscript.echo "An unexpected error has occured."
        End If
    Else
        wscript.echo "No matching """ & FileExt &""" files were found in """ & foldertocheck & """ to copy."
    End If
Else
    wscript.echo "Error: Source folder does not exist """ & foldertocheck & """."
End If

fileList.Close

Function PreProcessing
    Dim source, destination, ext, recent

    ' Initialize some variables
    Set source = Nothing
    Set destination = Nothing
    Set ext = Nothing
    Set recent = Nothing

    source = wscript.arguments.Named.Item("source")
    destination = wscript.arguments.Named.Item("destination")
    ext = wscript.arguments.Named.Item("ext")
    recent = wscript.arguments.Named.Item("recent")

    If source <> "" Then FolderToCheck = source
    If destination <> "" Then FolderDestination = destination
    If ext <> "" Then FileExt = ext
    If recent <> "" Then mostRecent = int(recent)

End Function

Open in new window


Solution 2: This solution will recursively copy files from sub-folders within a directory based on file type to a separate folder

Dim objFSO		: Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objStartFolder	: objStartFolder = "C:\Users\Desktop\3rd Party"
Dim objDestFolder	: objDestFolder = "C:\Users\Desktop\3rd Party\Work Folder"
Dim objFolder		: Set objFolder = objFSO.GetFolder(objStartFolder)
Dim Subfolder
Dim colFiles
Dim objFile

Set objDestFolder = objFSO.GetFolder(objDestFolder)

CopySubFolders objFSO.GetFolder(objStartFolder)

Sub CopySubFolders(Folder)
    For Each Subfolder in Folder.SubFolders
        		
			Set objFolder = objFSO.GetFolder(Subfolder.Path)
			Set colFiles = objFolder.Files
			For Each objFile in colFiles
			If instr(objFile.path,"3rd Party")  AND lcase(Right(objFile.Name,4))=".csv" Then
			'Wscript.echo "Copying File:" & objFile.path
        		ObjFSO.CopyFile objFile.Path, "C:\Users\Desktop\3rd Party\Work Folder\"
			End If
		
			If instr(objFile.path,"3rd Party")  AND lcase(Right(objFile.Name,4))=".xlsx" Then
			'Wscript.echo "Copying File:" & objFile.path
        		ObjFSO.CopyFile objFile.Path, "C:\Users\Desktop\3rd Party\Work Folder\"
			End If
		
			If instr(objFile.path,"3rd Party")  AND lcase(Right(objFile.Name,4))=".xls" Then
			'Wscript.echo "Copying File:" & objFile.path
        		ObjFSO.CopyFile objFile.Path, "C:\Users\Desktop\3rd Party\Work Folder\"
			End If
	
        Next
        CopySubFolders Subfolder
    Next
End Sub

Open in new window


So what I need is to search through the sub folders and copy the files in each folder based on 2 things: That the date last modified is the current date and that the file type is either csv, xls or xlsx.

I also found a code snippet that is supposed to skip certain folders, but if I place this code inside the
For Each

Open in new window

loop then it just bombs out - "Expected Statement".

Here is the code:

If Subfolder.Name <> "Exchange" and Subfolder.Name <> "HR_Daily_terminations" and Subfolder.Name <> "pay" and Subfolder.Name <> "Terminations" and Subfolder.Name <> "Work Folder" Then

Open in new window


Just before the
Fore Each

Open in new window

loop ends, I put the
End If

Open in new window

statement.

So it would look like this:

For Each Subfolder in Folder.SubFolders
        If Subfolder.Name <> "Exchange" and Subfolder.Name <> "HR_Daily_terminations" and Subfolder.Name <> "pay" and Subfolder.Name <> "Terminations" and Subfolder.Name <> "Work Folder" Then
		
			Set objFolder = objFSO.GetFolder(Subfolder.Path)
			Set colFiles = objFolder.Files
			For Each objFile in colFiles
			If instr(objFile.path,"3rd Party")  AND lcase(Right(objFile.Name,4))=".csv" Then
			'Wscript.echo "Copying File:" & objFile.path
        		ObjFSO.CopyFile objFile.Path, "C:\Users\Desktop\3rd Party\Work Folder\"
			End If
		
			If instr(objFile.path,"3rd Party")  AND lcase(Right(objFile.Name,4))=".xlsx" Then
			'Wscript.echo "Copying File:" & objFile.path
        		ObjFSO.CopyFile objFile.Path, "C:\Users\Desktop\3rd Party\Work Folder\"
			End If
		
			If instr(objFile.path,"3rd Party")  AND lcase(Right(objFile.Name,4))=".xls" Then
			'Wscript.echo "Copying File:" & objFile.path
        		ObjFSO.CopyFile objFile.Path, "C:\Users\Desktop\3rd Party\Work Folder\"
			End If
		End If
	
        Next
        CopySubFolders Subfolder
    Next

Open in new window

Eitel DagninIT Security AdministratorAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Ben Personick (Previously QCubed)Lead Network EngineerCommented:
You have your Next and end if order reversed.

Original Code, along with context code from Example 2

Dim objFSO		: Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objStartFolder	: objStartFolder = "C:\Users\Desktop\3rd Party"
Dim objDestFolder	: objDestFolder = "C:\Users\Desktop\3rd Party\Work Folder"
Dim objFolder		: Set objFolder = objFSO.GetFolder(objStartFolder)
Dim Subfolder
Dim colFiles
Dim objFile

Set objDestFolder = objFSO.GetFolder(objDestFolder)

CopySubFolders objFSO.GetFolder(objStartFolder)
	For Each Subfolder in Folder.SubFolders
		If (Subfolder.Name <> "Exchange" and Subfolder.Name <> "HR_Daily_terminations" and Subfolder.Name <> "pay" and Subfolder.Name <> "Terminations" and Subfolder.Name <> "Work Folder") Then
			Set objFolder = objFSO.GetFolder(Subfolder.Path)
			Set colFiles = objFolder.Files
			For Each objFile in colFiles
				If instr(objFile.path,"3rd Party")  AND lcase(Right(objFile.Name,4))=".csv" Then
					'Wscript.echo "Copying File:" & objFile.path
					ObjFSO.CopyFile objFile.Path, "C:\Users\Desktop\3rd Party\Work Folder\"
				End If
			
				If instr(objFile.path,"3rd Party")  AND lcase(Right(objFile.Name,4))=".xlsx" Then
				'Wscript.echo "Copying File:" & objFile.path
					ObjFSO.CopyFile objFile.Path, "C:\Users\Desktop\3rd Party\Work Folder\"
				End If
			
				If instr(objFile.path,"3rd Party")  AND lcase(Right(objFile.Name,4))=".xls" Then
				'Wscript.echo "Copying File:" & objFile.path
					ObjFSO.CopyFile objFile.Path, "C:\Users\Desktop\3rd Party\Work Folder\"
				End If
			Next
			CopySubFolders Subfolder
		End If
	Next
End Sub

Open in new window


Edit:  Also this simplifies your If statements and reduces time to run:

Dim objFSO		: Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objStartFolder	: objStartFolder = "C:\Users\Desktop\3rd Party"
Dim objDestFolder	: objDestFolder = "C:\Users\Desktop\3rd Party\Work Folder"
Dim objFolder		: Set objFolder = objFSO.GetFolder(objStartFolder)
Dim Subfolder
Dim colFiles
Dim objFile

Set objDestFolder = objFSO.GetFolder(objDestFolder)

CopySubFolders objFSO.GetFolder(objStartFolder)
	For Each Subfolder in Folder.SubFolders
		If (Subfolder.Name <> "Exchange" and Subfolder.Name <> "HR_Daily_terminations" and Subfolder.Name <> "pay" and Subfolder.Name <> "Terminations" and Subfolder.Name <> "Work Folder") Then
			Set objFolder = objFSO.GetFolder(Subfolder.Path)
			Set colFiles = objFolder.Files
			For Each objFile in colFiles
				set colFileExt = lcase(Right(objFile.Name,4))
				If ( (instr(objFile.path,"3rd Party")) AND ( colFileExt=".csv" OR colFileExt=".xlsx" OR colFileExt=".xls") ) Then
					'Wscript.echo "Copying File:" & objFile.path
					ObjFSO.CopyFile objFile.Path, "C:\Users\Desktop\3rd Party\Work Folder\"
				End If
			Next
			CopySubFolders Subfolder
		End If
	Next
End Sub

Open in new window


Edit: I added in the larger coded context since this was just the portion inside of the subfunction without the rest of the VB Script.

If you still want to see if stand-alone without the rest of the wrapper it's these two:

Original IF statements:
For Each Subfolder in Folder.SubFolders
	If (Subfolder.Name <> "Exchange" and Subfolder.Name <> "HR_Daily_terminations" and Subfolder.Name <> "pay" and Subfolder.Name <> "Terminations" and Subfolder.Name <> "Work Folder") Then
		Set objFolder = objFSO.GetFolder(Subfolder.Path)
		Set colFiles = objFolder.Files
		For Each objFile in colFiles
			If instr(objFile.path,"3rd Party")  AND lcase(Right(objFile.Name,4))=".csv" Then
				'Wscript.echo "Copying File:" & objFile.path
				ObjFSO.CopyFile objFile.Path, "C:\Users\Desktop\3rd Party\Work Folder\"
			End If
		
			If instr(objFile.path,"3rd Party")  AND lcase(Right(objFile.Name,4))=".xlsx" Then
			'Wscript.echo "Copying File:" & objFile.path
				ObjFSO.CopyFile objFile.Path, "C:\Users\Desktop\3rd Party\Work Folder\"
			End If
		
			If instr(objFile.path,"3rd Party")  AND lcase(Right(objFile.Name,4))=".xls" Then
			'Wscript.echo "Copying File:" & objFile.path
				ObjFSO.CopyFile objFile.Path, "C:\Users\Desktop\3rd Party\Work Folder\"
			End If
		Next
		CopySubFolders Subfolder
	End If
Next

Open in new window


Simplified:
For Each Subfolder in Folder.SubFolders
	If (Subfolder.Name <> "Exchange" and Subfolder.Name <> "HR_Daily_terminations" and Subfolder.Name <> "pay" and Subfolder.Name <> "Terminations" and Subfolder.Name <> "Work Folder") Then
		Set objFolder = objFSO.GetFolder(Subfolder.Path)
		Set colFiles = objFolder.Files
		For Each objFile in colFiles
			set colFileExt = lcase(Right(objFile.Name,4))
			If ( (instr(objFile.path,"3rd Party")) AND ( colFileExt=".csv" OR colFileExt=".xlsx" OR colFileExt=".xls") ) Then
				'Wscript.echo "Copying File:" & objFile.path
				ObjFSO.CopyFile objFile.Path, "C:\Users\Desktop\3rd Party\Work Folder\"
			End If
		Next
		CopySubFolders Subfolder
	End If
Next

Open in new window

0
Bill PrewIT / Software Engineering ConsultantCommented:
Okay, here's how I would approach it, see if this makes sense, and works for you.

' Require variables to be defined
Option Explicit

' Global variables
Dim strBaseFolder
Dim strDestFolder
Dim objFSO		
Dim objFolder
Dim objFile

' Define folders to work with
strBaseFolder = "C:\Users\Desktop\3rd Party"
strDestFolder = "C:\Users\Desktop\3rd Party\Work Folder"

' Create filesystem object
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Exit if base folder does not exist
If Not objFSO.FolderExists(strBaseFolder) Then
    Wscript.Echo "Missing base folder : """ & strBaseFolder & """"
    Wscript.Quit
End If

' Exit if dest folder does not exist
If Not objFSO.FolderExists(strDestFolder) Then
    Wscript.Echo "Missing dest folder : """ & strDestFolder & """"
    Wscript.Quit
End If

' Look at each subfolder of base folder
For Each objFolder In objFSO.GetFolder(strBaseFolder).SubFolders
    ' Continue if we want this folder
    If IncludeFolder(objFolder) Then
        ' Check each file in this folder
        For Each objFile In objFolder.Files
            ' Continue if we want this file
            If IncludeFile(objFile) Then
                ' Copy the file
                Wscript.Echo "Copying File :""" & objFile.Path & """"
                objFile.Copy strDestFolder
            End If
        Next
    End If
Next

' Logic to determine if we process a folder
Function IncludeFolder(objFolder)
    ' Exclude certain folder names
    Select Case LCase(objFolder.Name)
        Case "exchange", "hr_daily_terminations", "pay", "terminations", "work folder"
            IncludeFolder = False
        Case Else
            IncludeFolder = True
    End Select
End Function

' Logic to determine if we process a file
Function IncludeFile(objFile)
    IncludeFile = False
    Select Case LCase(objFSO.GetExtensionName(objFolder.Path))
        ' Include only these extensions
        Case "csv", "xls", "xlsx"
            ' Include only files dated today
            If DateDiff("d", objFile.DateLastModified, Now) = 0 Then
                IncludeFile = True
            End If
    End Select
End Function

Open in new window


»bp
0
Eitel DagninIT Security AdministratorAuthor Commented:
Hi all,

Thank you very much for your replies, I have tried both but to no avail.

@Ben - If I make use of the code under the heading Edit:  Also this simplifies your If statements and reduces time to run: then I get an error:

Line 26 - Expected Statement
Line 26 is the
End Sub

Open in new window


If I remove line 26, then I get the following error:

Line 11 - Type mismatch
Line 11 is the
CopySubFolders objFSO.GetFolder(objStartFolder)

Open in new window

I am currently stuck on this... I do appreciate your answer, especially because it makes my code a lot cleaner.

@Bill - Thank you for this complete code, it also makes the initial setup much cleaner, however, when I run the code, absolutely nothing happens. No errors, nothing gets moved - perhaps its stuck in some kind of loop I just cannot see??

As for the approach, it makes a lot of sense "doing the work" within a function then simply "calling" the function in the main execution - it's really good, thank you :)
0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Bill PrewIT / Software Engineering ConsultantCommented:
Okay, found two small problems and corrected them, this seems to work in a test here.

' Require variables to be defined
Option Explicit

' Global variables
Dim strBaseFolder
Dim strDestFolder
Dim objFSO		
Dim objFolder
Dim objFile

' Define folders to work with
strBaseFolder = "C:\Users\Desktop\3rd Party"
strDestFolder = "C:\Users\Desktop\3rd Party\Work Folder"

' Create filesystem object
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Exit if base folder does not exist
If Not objFSO.FolderExists(strBaseFolder) Then
    Wscript.Echo "Missing base folder : """ & strBaseFolder & """"
    Wscript.Quit
End If

' Exit if dest folder does not exist
If Not objFSO.FolderExists(strDestFolder) Then
    Wscript.Echo "Missing dest folder : """ & strDestFolder & """"
    Wscript.Quit
End If

' Look at each subfolder of base folder
For Each objFolder In objFSO.GetFolder(strBaseFolder).SubFolders
    ' Continue if we want this folder
    If IncludeFolder(objFolder) Then
        ' Check each file in this folder
        For Each objFile In objFolder.Files
            ' Continue if we want this file
            If IncludeFile(objFile) Then
                ' Copy the file
                Wscript.Echo "Copying File :""" & objFile.Path & """"
                objFile.Copy strDestFolder & "\" & objFile.Name
            End If
        Next
    End If
Next

' Logic to determine if we process a folder
Function IncludeFolder(objFolder)
    ' Exclude certain folder names
    Select Case LCase(objFolder.Name)
        Case "exchange", "hr_daily_terminations", "pay", "terminations", "work folder"
            IncludeFolder = False
        Case Else
            IncludeFolder = True
    End Select
End Function

' Logic to determine if we process a file
Function IncludeFile(objFile)
    IncludeFile = False
    Select Case LCase(objFSO.GetExtensionName(objFile.Path))
        ' Include only these extensions
        Case "csv", "xls", "xlsx"
            ' Include only files dated today
            If DateDiff("d", objFile.DateLastModified, Now) = 0 Then
                IncludeFile = True
            End If
    End Select
End Function

Open in new window


»bp
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Eitel DagninIT Security AdministratorAuthor Commented:
Hi Bill,

Thank you so much for your help! In actual fact, apart from the 2 small problems you mentioned, I was being a real dumbass.... The path I used in my question above is the path to the copied files - not the original files - and as such, the date last modified was obviously not today, so it would never have found files anyway... But its working smoothly! Thank you :)
0
Bill PrewIT / Software Engineering ConsultantCommented:
Welcome.


»bp
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.