Script to move subdirectories to new directory

Hello,
I have a directory that has several folders. Within each of the folders is another folder with the same name as it (i.e. c:\temp\ABC_12345678\ABC_12345678), along with other content.  I want to just take these "last" folders (and their content) and put them all into the same, new directory. I'd appreciate annotated code, so I can figure out whats happening.

this:
c:\temp\ABC_12345678\ABC_12345678
c:\temp\ABC_xxxxxxxx\ABC_xxxxxxxx
to this:
c:\new\ABC_12345678
c:\new\ABC_xxxxxxxx
etc

Thank you kindly,
MJ
mgjustAsked:
Who is Participating?
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.

RobSampsonCommented:
Hi, do these "last" folders have any subfolders in them as well? Or are they just files?  Just files would be easier to handle.....

Regards,

Rob.
0
mgjustAuthor Commented:
Hello,
They just have files. I believe that they all have 6.

Thanks,
MJ
0
RobSampsonCommented:
Hi, this script should identify the deepest folder and copy files out of that, up one folder.
If you want to delete the folder that you just moved it out of, uncomment this line:
'objFSO.DeleteFolder objFSO.GetParentFolderName(objFile.Path), True      

'===========
strParentFolder = "C:\TEMP\Temp\Test script\Test"
If Right(strParentFolder, 1) <> "\" Then strParentFolder = strParentFolder & "\"

Set objFSO = CreateObject("Scripting.FileSystemObject")

For Each objSubFolder In objFSO.GetFolder(strParentFolder).SubFolders
      MoveOutFiles(objSubFolder)
Next

MsgBox "Done."

Sub MoveOutFiles(objFolder)
      ' First we need to identify if this is the deepest folder
      If objFolder.SubFolders.Count = 0 Then
            For Each objFile In objFolder.Files
                  strTargetFolder = objFSO.GetFolder(objFSO.GetParentFolderName(objFile.Path)).ParentFolder.Name
                  If Right(strTargetFolder, 1) <> "\" Then strTargetFolder = strTargetFolder & "\"
                  MsgBox "Moving " & objFile.Path & " to " & VbCrLf & strTargetFolder & objFile.Name
                  ' Delete the file if it exists in the target location before moving the required file.
                  If objFSO.FileExists(strTargetFolder & objFile.Name) = True Then
                        objFSO.DeleteFile strTargetFolder & objFile.Name, True
                  End If
                  objFSO.MoveFile objFile.Path, strTargetFolder & objFile.Name
            Next
            'objFSO.DeleteFolder objFSO.GetParentFolderName(objFile.Path), True      
      Else
            For Each objSubFolder In objFolder.SubFolders
                  MoveOutFiles(objSubFolder)
            Next
      End If
End Sub
'===========

Regards,

Rob.
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
PMI ACP® Project Management

Prepare for the PMI Agile Certified Practitioner (PMI-ACP)® exam, which formally recognizes your knowledge of agile principles and your skill with agile techniques.

mgjustAuthor Commented:
Rob,
Thank you but I have one, maybe two issues:

1.) an error message:
Line: 23
Char: 19
Error: Path not found
code: 800A004C
Source: Microsoft VBScript runtime error

2.) as stated above this is what i would like to do.
this:
c:\temp\ABC_12345678\ABC_12345678
c:\temp\ABC_xxxxxxxx\ABC_xxxxxxxx
to this:
c:\new\ABC_12345678
c:\new\ABC_xxxxxxxx

Your script moves them one up, which I think should work just fine.  As mentioned, there are other files in the "1 up from the last directory". I don't need them, so if there is a way to remove them easily that would be cool. However, if not, I don't think they will impact my usage of the files that are being moved.

Thank you again,
MJ
0
mgjustAuthor Commented:
Okay, I used the code below and it works. It leaves the last directory empty, not delete, which is fine and moves the files on up. I also commented out the message part to speed up the process.

Thanks again.

strParentFolder = "C:\atest"
If Right(strParentFolder, 1) <> "\" Then strParentFolder = strParentFolder & "\"
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
For Each objSubFolder In objFSO.GetFolder(strParentFolder).SubFolders
      MoveOutFiles(objSubFolder)
Next
 
MsgBox "Done."
 
Sub MoveOutFiles(objFolder)
      ' First we need to identify if this is the deepest folder
      If objFolder.SubFolders.Count = 0 Then
            For Each objFile In objFolder.Files
                  strTargetFolder = objFSO.GetFolder(objFSO.GetParentFolderName(objFile.Path)).ParentFolder.Name
                  If Right(strTargetFolder, 1) <> "\" Then strTargetFolder = strTargetFolder & "\"
                  ' MsgBox "Moving " & objFile.Path & " to " & strParentFolder & strTargetFolder & objFile.Name
                  ' Delete the file if it exists in the target location before moving the required file.
                  If objFSO.FileExists(strParentFolder & strTargetFolder & objFile.Name) = True Then
                        objFSO.DeleteFile strParentFolder & strTargetFolder & objFile.Name, True
                  End If
                  objFSO.MoveFile objFile.Path, strParentFolder & strTargetFolder & objFile.Name
            Next
            ' objFSO.DeleteFolder strTargetFolder, True      
      Else
            For Each objSubFolder In objFolder.SubFolders
                  MoveOutFiles(objSubFolder)
            Next
      End If
End Sub

Open in new window

0
RobSampsonCommented:
Great. Nice work.

To delete the folder, it looks like you'll need to change (and uncomment) this:
' objFSO.DeleteFolder strTargetFolder, True

to this:
' objFSO.DeleteFolder strParentFolder & strTargetFolder

Regards,

Rob.
0
mgjustAuthor Commented:
Thanks again.
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
Windows Batch

From novice to tech pro — start learning today.