Move SubFolders based on extension of contained files

[ajhoward]

Hi Everyone,

I am trying to make up this script but am needing someones expertise. What I am trying to do is a recursive search of folder a, if any of the sub-folders within contain files with a particular extension, then move the sub-folder, all folders within and all the files to folder b maintaining the same folder structure. Continue this until all sub-folders, folders within and the specified extension files have been moved to folder b in the same structure as within folder a. I have seen on other websites that this is referred to as "nested folder" and is quite difficult. So I also seen that "robocopy" would achieve this, so I was thinking of using robocopy, but don't know how to do it. Here is the recursive script I began with:


OPTION EXPLICIT
DIM strExtensionsToDelete,strFolder,strDestination,WSHshell
DIM objFSO

' ************************************************************
' Setup
' ************************************************************

' Folder to delete files from (files will also be deleted from subfolders)
strFolder = "D:\My Downloads\FireFox Downloads"
strDestination = "D:\My Downloads\Incomplete\"
' A comma separated list of file extensions
' Files with extensions provided in the list below will be deleted
strExtensionsToDelete = "txt"

' ************************************************************

set objFSO = createobject("Scripting.FileSystemObject")

RecursiveDeleteByExtension strFolder,strExtensionsToDelete

WScript.echo "Finished"

sub RecursiveDeleteByExtension(byval strDirectory,strExtensionsToDelete)
DIM objFolder, objSubFolder, objFile
DIM strExt

set objFolder = objFSO.GetFolder(strDirectory)
WScript.Echo "strDirectory = " & strDirectory
WScript.Echo "objFolder = " & objFolder
for each objFile in objFolder.Files
WScript.Echo objFile
for each strExt in SPLIT(UCASE(strExtensionsToDelete),",")
if RIGHT(UCASE(objFile.Path),LEN(strExt)+1) = "." & strExt then
WScript.echo "Deleting:" & objFile.Path
WScript.Echo "objFolder = " & objFolder
WScript.Echo "objFile.Path = " & objFile.Path
WScript.Echo "objFolder.Path = " & objFolder.Path
Set WSHShell = CreateObject("Wscript.Shell")
Call WshShell.Run("cmd robocopy" & objFolder & strDestination)
'objFSO.CreateFolder "D:\My Downloads\Incomplete\New Folder"
'objFolder.Move StrDestination
WScript.Echo "strDestination = " & strDestination
'WScript.Echo "objFolder = " & objFolder
exit for
end if
next
next
for each objSubFolder in objFolder.SubFolders
WScript.Echo "objSubFolder = " & objSubFolder
RecursiveDeleteByExtension objSubFolder.Path,strExtensionsToDelete
next
end sub

 

[Geates]

I have not heard of Robocopy. I would do in two steps. Something like...

1. Find folders
2. Move them

set objFSO = CreateObject("Scripting.FileSystemObject")
set objShell = CreateObject("WScript.Shell")

strSource = "C:\Downloads"
strDestination = "C:\Incomplete"

function createDirectory (strDir)
	if (right(strDir, 1) = "\") then strDir = left(strDir, len(strDir) - 1)
	strParentDir = objFSO.GetParentFolderName(strDir)
	if NOT (objFSO.FolderExists(strParentDir)) then createDirectory (strParentDir)
	if NOT (objFSO.FolderExists(strDir)) then objFSO.CreateFolder strDir
end function

function searchDir(strDir, strQuery)
    set objFolder = objFSO.GetFolder(strDir)
    for each objSubFolder in objFolder.SubFolders
        strResults = strResults & searchDir(objSubFolder.Path, strQuery)
    next
	
    for each objFile in objFolder.Files
        if (inStr(objFile.Name, strQuery)) then
            strResults = strResults & objFolder.Path & vbNewLine
            exit for
        end if
    next
    searchDir = strResults
end function

'Get folders
arrFolders = split(searchDir(strSource, ".mp3"), vbNewLine)

'Move folder
for i = 0 to ubound(arrFolders) - 1
    strSrc = arrFolders(i)
    strDst = replace(arrFolders(i), strSource, strDestination)
    createDirectory objFSO.GetParentFolderName(strDst)
    objFSO.MoveFolder strSrc, strDst
next

-Geates

"I hope I can feel and see the change - stop the bleed inside a feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer

 

[ajhoward]

Thanks Geates for replying, your a champion
I am getting file exists error on line 37,5 objFSO.MoveFolder strSrc, strDst

Andrew

Thankyou for your help

 

[Geates]

Does your destination directory already exist? Or it's parent? you will get this error if so. Add this code just before the Move Folder for..loop

createDirectory(strDestination)

if that doesn't work add a msgbox strDst in the loop to see what folder is next move and to where.

-Geates

"I hope I can feel and see the change - stop the bleed inside a feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer

 

[ajhoward]

Yes the destination does exist already. The destination directory is D:\My Downloads\Incomplete. Both options from you have the same result. However in the test source folder I am using it creates a copy of the sub-folder that I am moving in the destination folder. The source sub-folder has 3 sub-folders, it copies 2 of them but not the other. The other sub-folder is the only folder that doesn't have folders within it. Does that make sense, sorry if it is confusing.

Andrew

Thankyou for your help

 

[ajhoward]

Sorry, I said both options from had the same result. The msgbox command that I put in returned the correct directories, and the error occurred when it arrived at the folder that doesn't have any folders within it. I'll try and explain myself better than before, so inside D:\MyDownloads(SourceFolder)
there is D:\MyDownloads\FolderToMove\FolderA\more folders
D:\MyDownloads\FolderToMove\FolderB\more folders
D:\MyDownloads\FolderToMove\FolderC\only files<--this is when the error occurs.

Andrew

Thankyou for your help

 

[Geates]

I didn't get that error under those circumstances. However, I did get the error when..

Folder A\Folder AA (moved)
Folder A\Folder AB (moved)
Folder A\File A <-- error

it's erroring out because Folder A already exists from when the subfolders AA and AB were created. In this case, you'll need to trap this error and move the files separately.

untested

for i = 0 to ubound(arrFolders) - 1
    strSrc = arrFolders(i)
    strDst = replace(arrFolders(i), strSource, strDestination)
    createDirectory objFSO.GetParentFolderName(strDst)
    [green]Err.Number = 0
    on resume resume next[/green]    
    objFSO.MoveFolder strSrc, strDst
    [green]if (Err.Number) then
        for each objFile in objFSO.GetFolder(strSrc).Files
            objFile.Move strDst, true
        next
    end if[/green]
next

-Geates

"I hope I can feel and see the change - stop the bleed inside a feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer

 

[Geates]

Actually, I suppose the correct way to do it would be to not let such error occur in the first place.

for i = 0 to ubound(arrFolders) - 1
    strSrc = arrFolders(i)
    strDst = replace(arrFolders(i), strSource, strDestination)
    createDirectory objFSO.GetParentFolderName(strDst)
    [green]if (objFSO.FolderExists(strDst)) then
        for each objFile in objFSO.GetFolder(strSrc).Files
            objFile.Move strDst & "\", true
        next
        objFSO.DeleteFolder strSrc
    else[/green]
        objFSO.MoveFolder strSrc, strDst
    [green]end if[/green]
next

Line 7: Because you are moving a file to an already existing destination, the destination path must end with a '\'.

Line 9: Once all the files are moved, be sure to delete the source folder.

-Geates

"I hope I can feel and see the change - stop the bleed inside a feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer

 

[ajhoward]

Microsoft VBScript runtime error (45, 13) : Wrong number of arguments or invalid property assignment: 'objFile.Move'

'Move folder
for i = 0 to ubound(arrFolders) - 1
strSrc = arrFolders(i)
strDst = replace(arrFolders(i), strSource, strDestination)
createDirectory objFSO.GetParentFolderName(strDst)
if (objFSO.FolderExists(strDst)) then
for each objFile in objFSO.GetFolder(strSrc).Files
'WScript.Echo "objFile" & Space(2) & objFile
objFile.Move strDst & "\", True <--------
next
objFSO.DeleteFolder strSrc
else
objFSO.MoveFolder strSrc, strDst

End if
next

Andrew

Thankyou for your help

 

[ajhoward]

It is going through the folders top to bottom. It looks like when it hits D:\My Downloads\Utorrent Downloads\FolderToMove\FolderA\FolderAA there is a FolderAAA inside, but it moves FolderAAA with its contained files but leaves FolderAA and its files behind. I tried changing the move command to copy and it seems to work, however it leaves behind the FolderToMove.

Andrew

Thankyou for your help

 

[Geates]

oh yeah. That's because objFile.Move accepts only 1 argument not 2.

change
objFile.Move strSrc & "\", true

to
objFile.Move strSrc & "\"

-Geates


"I hope I can feel and see the change - stop the bleed inside a feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer

 

[ajhoward]

That worked a treat. Thankyou for your patience and taking the time to walk me through this script and answering my post in the first place. Hopefully next time I post on here you won't be the poor bugger that ends up answering it. Will probably when I do MCSE or MCITP. Have a good one

Andrew

Thankyou for your help

 

[ajhoward]

I forgot to ask you something, just one last thing. How do I modify it so that it will also move only files with the specified extension from the source folder directory as well ie files are that are in the source folder but not in a folder of there own.

Andrew

Thankyou for your help

 

[Geates]

I think this is what you mean.

for i = 0 to ubound(arrFolders) - 1
    strSrc = arrFolders(i)
    strDst = replace(arrFolders(i), strSource, strDestination)
    createDirectory objFSO.GetParentFolderName(strDst)
    if (objFSO.FolderExists(strDst)) then
        for each objFile in objFSO.GetFolder(strSrc).Files
            [green]if (right(objFile.Name, 4) = ".ext") then[/green]
                objFile.Move strDst & "\", true
            [green]end if[/green]    
        next
        objFSO.DeleteFolder strSrc
    else
        objFSO.MoveFolder strSrc, strDst
    end if
next

This will move .ext files "left over" from a when their sibling folders were moved. Bare in mind that it then deletes the folder, thus any file WITHOUT the extension ".ext"

-Geates

"I hope I can feel and see the change - stop the bleed inside a feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer

 

[ajhoward]

What I mean is in the source folder (D:\My Downloads\Firefox Downloads) the script moves the folders within, but if there is files with and without the specified extension, move only the files with the specified extension only, and leave the other files, and the source folder there ie Firefox Downloads. Only do this with the extension files in the source folder, what the script does with the other folders within the source folder is right.

Andrew

Thankyou for your help

 

[ajhoward]

I apologize, it did work except for the deleting the source folder as you said, but I sorted that.Thanks again for your help, sorry for the headache.

'Move folder
for i = 0 to ubound(arrFolders) - 1
strSrc = arrFolders(i)
strDst = replace(arrFolders(i), strSource, strDestination)
createDirectory objFSO.GetParentFolderName(strDst)
if (objFSO.FolderExists(strDst)) then
for each objFile in objFSO.GetFolder(strSrc).Files
if (right(objFile.Name, 4) = ".bc!") then
WScript.Echo "Duplicate file" & Space(2) & objFile & Space(2) & "is copying.."
objFile.Move strDst & "\"
End If
next
If strSrc <> StrSource Then 'added this line
WScript.Echo "Deleting folder" & Space(2) & strSrc
objFSO.DeleteFolder strSrc
End If
else
objFSO.MoveFolder strSrc, strDst
WScript.Echo "Moved from" & Space(2) & strSrc & "to" & Space(2) & strDst
Logging
End if
Next

WScript.Echo "Finished at " & Now


Andrew

Thankyou for your help