Recursively copy files from sub-folders based on date-stamp without cscript\cmd

[Eitel13]

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

4) The filename structure is Date_Filename

The code in the link above can solve my issue, but then I would have 20 scripts to run which I think is really unnecessary.

I found the code below that could help with what I need to do but I do not know how to amend the code so that I can simply double click to run the vbs file instead of having to use cscipt in cmd to execute it. As of yet, I havent been able to test this code either...

'Variables -----
'"\Desktop\3rd Party\"                      ' Folder Source to check for recent files to copy FROM
'"\Desktop\3rd Party\New folder\"       ' Destination Folder where to copy files TO

Const ForReading = 1
Const ForWriting = 2

Set objArgs = WScript.Arguments
If objArgs.Count < 2 Then
    MsgBox "Missing argument <source_path> <target_path>"
    WScript.Quit
End If

strSrcPath = objArgs(0)
strDestPath = objArgs(1)

Call CopyFolderRecursively(strSrcPath, strDestPath)
msgbox "done"


Sub CopyFolderRecursively(strSrcPath, strDestPath)
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objCurrentFolder = objFSO.GetFolder(strSrcPath)

    For Each objFile In objCurrentFolder.Files
        ' Create new folder if it's not there
        If Not objFSO.FolderExists(strDestPath) Then objFSO.CreateFolder(strDestPath)

        strDestFile = strDestPath & "\" & objFile.Name

        ' do a direct copy here
        objFSO.CopyFile objFile, strDestFile

    Next

    For Each objFolder In objCurrentFolder.subFolders
        Call CopyFolderRecursively(objFolder, strDestPath & "\" & objFolder.Name)
    Next
End Sub

 

[xwb]

1) Create a shortcut to the VBS file
2) Modify the shortcut
3) Change the target to "C:\windows\system32\cscript.exe" "full path to the vbs file" arg1 arg2 ...
4) Save the shortcut.

Now all you need to do is doubleclick on the shortcut to run the program

 

[Eitel13]

Hi xwb, thank you for the reply, I did the following:

1) The main vbs file is on my desktop
2) I created a shortcut to the vbs file - so now the shortcut and the vbs file are both on my desktop
3) I modified the path of the shortcut to read:

"C:\Windows\System32" "C:\Users\test\Desktop"​

4) I get the following error:

The folder "C:\Windows\System32" "C:\Users\xy56079\Desktop" specified in the Start In box is not valid. make sure that the folder exists and that the path is correct.​

I tried specifying the path both with and without inverted comma's and both ways I get the same error.

Is there no way I can just modify the code in the main vbs file to make it "clickable"? As in have the path specified inside that file...

 

[mrmovie]

for the shortcut the 'startin' can just be blank, then you want:

c:\windows\system32\cscript.exe c:\pathtoscript\script.vbs "source_path_here" "target_path_here"

...you could also just create a .bat file or .cmd file and double click that.
...or you could hard code the variables in the .vbs (but i think that is admitting defeat)

I Hear, I Forget
I See, I Remember
I Do, I Understand

Ronald McDonald

 

[Eitel13]

Hi all,

I know its been a while since the last reply but I have been working on this and 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

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

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

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

Just before the

Fore Each

loop ends, I put the

End If

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

 

[Eitel13]

Hi All,

Please note I have found the solution to the problem above and the code is below:

Link:

https://www.experts-exchange.com/qu...olders-based-on-date-stamp-and-file-type.html

' 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

Thanks for all the help!