recursively move files from subfolders to another folder with vbscript - file

Question

I need to recurse a folder and all subfolders and move the pdf files to another folder. Looking here I tried the below but it seems to continuously run (the script never ends) but it does move the files.
I would also like to count the source files, recurse folder and move pdf (ignore case) files, count destinations files. If source and destination are equal then run dir *.pdf > trust.csv and send a success email
Set fso = CreateObject("Scripting.FileSystemObject")
Set Message = CreateObject("CDO.Message")
Set Shell = WScript.CreateObject("WScript.Shell")
Set shell = CreateObject("Wscript.shell")
'Specify variables for Emails
strScriptServer = "ASFOXTECHOPS01"
strScriptPath = "\\techopspc01\c$\scripts\WM..."
strScriptName = "[WM-01]-WMScansToCenterDoc.vbs"
'strToEmail = ""
strCCEmail = ""
strCCEmailFail = ""
strProcessID = "[WM-01]"
strCustomerImpact = "LOW"
strCorporateImpact = "LOW"
strDocumentation = "\\FSCHAFOX01\GROUP_SHARE\Tech Group\Documentation\Automation\"
blnEmailNotification = false
'Specify variables for File Paths
'strFromPath1 = "\\fschauni01\GROUP_SHARE\Wealth Management\Scanning\ZAstrosky\"
strToPath1 = "\\fschauni01\GROUP_SHARE\Wealth Management\Tech\"
strToArchive1 = "\\fschauni01\GROUP_SHARE\Wealth Management\Scanning\" & StrYear & "_" & strMonth
'BROKE************CREATE ARCHIVE FOLDER IF IT DOES NOT EXIST
'If FSO.FolderExists(strToArchive1) Then
'Proceed
'Else
' FSO.CreateFolder("\\fschauni01\GROUP_SHARE\Wealth Management\Scanning\" & StrYear & "_" & strMonth)
'End If
'DELETE FILES FROM THE strToPath(s) TO AVOID OVERWRITE ERRORS
FSO.DeleteFile (strToPath1 & "*.*")
testfolder = "\\fschauni01\GROUP_SHARE\Wealth Management\Tech\"
MoveFiles fso.GetFolder("\\fschauni01\GROUP_SHARE\Wealth Management\Scanning\ZAstrosky")
blnEmailNotification = True
'Email
'If Err <> 0 Then
' blnEmailNotification = false
' HandleError
'End If
If blnEmailNotification = True Then
'Send Results email
objMessage.Subject = "SUCCESS - " & strProcessID & " - WM Scanned Reports Imported into CenterDoc"
objMessage.From = "IT Automation"
objMessage.Sender = ""
'objMessage.To = strToEmail
objMessage.Cc = strCCEmail
objMessage.TextBody = "---------------SCRIPT SUCCESSFUL---------------" & vbnewline & VbCrLf & "Script successfully moved the files with no errors." & vbnewline & vbcrlf & "- Script Name:" & VbTab & VbTab & VbTab & strScriptName & VbNewLine & VbCrLf & "- Script Origination:" & VbTab & VbTab & strScriptServer & VbNewline & VbCrLf & "- Script Path:" & VbTab & VbTab & VbTab & strScriptPath & VbNewLine & VbCrLf & "- Documentation:" & VbTab & VbTab & strDocumentation & VbNewLine & VbCrLf & "- Set1:" &VbTab & VbTab & "Souce Files = " & sourcecount1 & VbTab & VbTab & "Destination Files = " & destcount1 & VbTab & VbTab & "Archive Files = " & archivecount1 & VbTab & VbTab & "------------------------------------------------------------"
objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = ""
objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
Else
'Do Nothing
End If
Sub HandleError
strErrorMessage = "Error Number " & Err.Number & ":" & Err.Description
objMessage.Subject = "SCRIPT ERROR - " & strProcessID & " - IMMEDIATE ACTION REQUIRED"
objMessage.From = "IT Automation"
objMessage.Sender = ""
objMessage.To = strToEmail
'objMessage.Cc = strCCEmail
objMessage.TextBody = "---------------SCRIPT ERROR---------------" & vbnewline & VbCrLf & "Script Name:" & VbTab & VbTab & VbTab & strScriptName & VbNewLine & VbCrLf & "Customer Impact:" & VbTab & VbTab & VbTab & strCustomerImpact & VbNewLine & VbCrLf & "Corporate Impact:" & VbTab & VbTab & VbTab & strCorporateImpact & VbNewLine & VbCrLf & "Error Description:" & VbTab & VbTab & VbTab & Err.Description & vbnewline & VbCrLf & "Error Number:" & VbTab & VbTab & VbTab & Err.Number & VbCrLf & VbNewLine & "Script Location:" & VbTab & VbTab & VbTab & strScriptServer & VbCrLf & VbNewLine & "Script Path:" & VbTab & VbTab & VbTab & strScriptPath & VbNewline & VbCrLf & "Documentation:" & VbTab & VbTab & strDocumentation & VbNewLine & VbCrLf & "-------------------------------------------------"
objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = ""
objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
Err.Clear
End Sub
Sub MoveFiles(fldr)
For Each f In fldr.Files
basename = fso.GetBaseName(f)
extension = fso.GetExtensionName(f)
If LCase(extension) = "pdf" Then
dest = fso.BuildPath(testfolder, f.Name)
Do While fso.FileExists(dest)
dest = fso.BuildPath(testfolder, basename & "." & extension)
Loop
f.Move dest
End If
Next
For Each sf In fldr.SubFolders
MoveFiles sf
Next
End Sub
Edited original code for more help.
thanks Zoyd
astro

Answer 1

You move all the pdf files from \\fschauni01\GROUP_SHARE\Wealth Management\Scanning\ZAstrosky and its subfolders to \\fschauni01\GROUP_SHARE\Wealth Management\Scanning\ZAstrosky\Tech. Your recursion logic is sound, but there is another problem: your destination folder is a subfolder of your source folder. Thus, your script keeps copying files from \\fschauni01\GROUP_SHARE\Wealth Management\Scanning\ZAstrosky\Tech to itself. Whether this works or not, it is a bad idea to do a foreach loop on a collection and modify its content.
The main problem is that this while loop will never end if it is taken at all, and in this case, it is taken. When your recursion reaches the destination folder, all the files already exist in the destination folder (obviously), the loop is taken and there is no way out of it.
If LCase(extension) = "pdf" Then
dest = fso.BuildPath(testfolder, f.Name)
Do While fso.FileExists(dest)
dest = fso.BuildPath(testfolder, basename & "." & extension)
Loop
f.Move dest
End If
As for the matter of counting files, does folder.Files.Count not work ? (if you need a recursive count, I'am afraid you'll have to do it yourself, but you know how).
After your edit, the code still contains this:
Do While fso.FileExists(dest)
dest = fso.BuildPath(testfolder, basename & "." & extension) ' ☠
Loop
So, for example, if a file a.pdf exists in "\\fschauni01\GROUP_SHARE\Wealth Management\Scanning\ZAstrosky\docs1" and in "\\fschauni01\GROUP_SHARE\Wealth Management\Scanning\ZAstrosky\docs2", your script will find that a.pdf already exists in the archive directory and enters the infinite loop. A way around this is to recreate the directory structure in the archive directory (each time you call MoveFiles on directoryA, create directoryA in the archive directory and move files there).