Solved

bring files two levels up

Posted on 2011-09-15
14
267 Views
Last Modified: 2012-05-12
Hi,

EEs helped me with this long time ago, what it does is to bring all files to one level up.
aaa
      folder1
         file1
      folder2
         file2
to

bbb
   file1
   file2


is there a way to change the code to bring the files two levels up?
aaa
    folder1
      sub1
         file1
      sub2
         file2
to

bbb
   file1
   file2


thanks
'This will copy all files to one level up

'option explicit

dim SourceFolder, DestFolder ,fso, f
Set fso = CreateObject("Scripting.FileSystemObject")




SourceFolder = "C:\aaa\"
DestFolder = "C:\bbb\"

Set f = fso.GetFolder(SourceFolder)
For Each file In f.Files
       fso.MoveFile SourceFolder  & file.Name, DestFolder  & file.name
Next 

For Each subdir in f.SubFolders 
     Set f = fso.GetFolder(SourceFolder  & subdir.name)
          For Each file In f.Files
               fso.copyFile SourceFolder  & subdir.name & "\" & file.Name, DestFolder  & file.name
          Next      
Next 

msgbox "Finished!!!"

Open in new window

0
Comment
Question by:mcrmg
  • 6
  • 6
  • 2
14 Comments
 
LVL 51

Expert Comment

by:Bill Prew
ID: 36545057
It looked like wanted the files 0, 1 and 2 levels down all moved, so that would look like this:

'This will copy all files to two levels up
Set oFSO = CreateObject("Scripting.FileSystemObject")

sBaseDir = "C:\aaa\"
sDestDir = "C:\bbb\"

Set oBaseDir = oFSO.GetFolder(sBaseDir)

For Each oFile In oBaseDir.Files
    oFile.Move DestFolder & oFile.Name
Next 

For Each oSubDir1 in oBaseDir.SubFolders 
    For Each oFile In oSubDir1.Files
        oFile DestFolder & oFile.Name
    Next      
    For Each oSubDir2 in oSubDir1.SubFolders 
        For Each oFile In oSubDir2.Files
            oFile DestFolder & oFile.Name
        Next      
    Next 
Next 

MsgBox "Finished!!!"

Open in new window

~bp
0
 

Expert Comment

by:haggard
ID: 36545061
I'm not positive tat I understand your question but I am guessing that what you want to do is to use c:\ as the base of your destination tree instead of c:\bbb. If that is the case then this should do it.

Change this line:
DestFolder = "C:\bbb\"

to
DestFolder = "C:\"

0
 

Author Comment

by:mcrmg
ID: 36545552
is it possible to add to "skip" or overwite the files that have already existed?  thnaks
0
 

Expert Comment

by:haggard
ID: 36545835
Disregard my previous answer. I misunderstood your question.
0
 
LVL 51

Expert Comment

by:Bill Prew
ID: 36545885
==> is it possible to add to "skip" or overwite the files that have already existed?

Yes, but which do you want, to skip them, or to overwrite them?

~bp
0
 

Author Comment

by:mcrmg
ID: 36545929
overwuite...lol
0
 
LVL 51

Expert Comment

by:Bill Prew
ID: 36545999
See how this goes.

'This will copy all files to two levels up
Set oFSO = CreateObject("Scripting.FileSystemObject")

sBaseDir = "C:\aaa\"
sDestDir = "C:\bbb\"

Set oBaseDir = oFSO.GetFolder(sBaseDir)

For Each oFile In oBaseDir.Files
    oFile.Move DestFolder & oFile.Name
Next 

For Each oSubDir1 in oBaseDir.SubFolders 
    for Each oFile In oSubDir1.Files
        If oFSO.FileExists(DestFolder & oFile.Name) Then
           oFSO.DeleteFile(DestFolder & oFile.Name)
        End If
        oFile.Move DestFolder & oFile.Name
    Next      
    For Each oSubDir2 in oSubDir1.SubFolders 
        For Each oFile In oSubDir2.Files
           If oFSO.FileExists(DestFolder & oFile.Name) Then
              oFSO.DeleteFile(DestFolder & oFile.Name)
           End If
            oFile.Move DestFolder & oFile.Name
        Next      
    Next 
Next 

MsgBox "Finished!!!"

Open in new window

~bp
0
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Author Comment

by:mcrmg
ID: 36546036
still getting File already exist error.
0
 
LVL 51

Expert Comment

by:Bill Prew
ID: 36546067
Okay, I'll set up some testing here and see how it goes.

~bp
0
 

Author Comment

by:mcrmg
ID: 36546073
thanks
0
 
LVL 51

Accepted Solution

by:
Bill Prew earned 250 total points
ID: 36546891
This works properly here, after I fixed a mistake I found.

'This will copy all files to two levels up
Set oFSO = CreateObject("Scripting.FileSystemObject")

sBaseDir = "C:\EE\EE27310567\base\"
sDestDir = "C:\EE\EE27310567\dest\"

Set oBaseDir = oFSO.GetFolder(sBaseDir)

For Each oFile In oBaseDir.Files
    oFile.Move DestFolder & oFile.Name
Next 

For Each oSubDir1 in oBaseDir.SubFolders 
    for Each oFile In oSubDir1.Files
        If oFSO.FileExists(sDestDir & oFile.Name) Then
           oFSO.DeleteFile(sDestDir & oFile.Name)
        End If
        oFile.Move sDestDir & oFile.Name
    Next      
    For Each oSubDir2 in oSubDir1.SubFolders 
        For Each oFile In oSubDir2.Files
           If oFSO.FileExists(sDestDir & oFile.Name) Then
              oFSO.DeleteFile(sDestDir & oFile.Name)
           End If
            oFile.Move sDestDir & oFile.Name
        Next      
    Next 
Next 

MsgBox "Finished!!!"

Open in new window

~bp
0
 

Author Comment

by:mcrmg
ID: 36548267
this piece is still giving me File Exist Error

For Each oFile In oBaseDir.Files
    oFile.Move DestFolder & oFile.Name
Next

after I removed it, it works fine.  There is no files in the root, but I dont undeerstand why it did not work..thanks
0
 
LVL 51

Expert Comment

by:Bill Prew
ID: 36548579
Okay, see if this works better.  I think this may be a VB version issue or a Windows version issue.  I never have to check the Files.Count, and can just do the loop and if there are no files it doesn't execute the loop and continues on.  But I see code like below often and suspect it's because of the behavior you are mentioning.

'This will copy all files to two levels up
Set oFSO = CreateObject("Scripting.FileSystemObject")

sBaseDir = "C:\EE\EE27310567\base\"
sDestDir = "C:\EE\EE27310567\dest\"

Set oBaseDir = oFSO.GetFolder(sBaseDir)

If oBaseDir.Files.Count > 0 Then
    For Each oFile In oBaseDir.Files
        oFile.Move DestFolder & oFile.Name
    Next 
End If

For Each oSubDir1 in oBaseDir.SubFolders 
    If oSubDir1.Files.Count > 0 Then
       For Each oFile In oSubDir1.Files
           If oFSO.FileExists(sDestDir & oFile.Name) Then
              oFSO.DeleteFile(sDestDir & oFile.Name)
           End If
           oFile.Move sDestDir & oFile.Name
       Next      
    End If
    For Each oSubDir2 in oSubDir1.SubFolders 
        If oSubDir2.Files.Count > 0 Then
           For Each oFile In oSubDir2.Files
              If oFSO.FileExists(sDestDir & oFile.Name) Then
                 oFSO.DeleteFile(sDestDir & oFile.Name)
              End If
               oFile.Move sDestDir & oFile.Name
           Next      
        End If
    Next 
Next 

MsgBox "Finished!!!"

Open in new window

~bp
0
 

Author Comment

by:mcrmg
ID: 36548673
thank you very much
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Welcome to part one of a multi-part tutorial series, VBScript for Windows System Administrators.  The goal of this series is to teach non-programmers how to write useful VBS code to automate their environment, and perform tasks faster, and in a more…
Over the years I have built up my own little library of code snippets that I refer to when programming or writing a script.  Many of these have come from the web or adaptations from snippets I find on the Web.  Periodically I add to them when I come…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
This video discusses moving either the default database or any database to a new volume.

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now