?
Solved

Script to Move files into subfolders

Posted on 2005-04-14
15
Medium Priority
?
6,613 Views
Last Modified: 2008-01-09
I have a directory with over 30,000 files in it and windows explorer freaks out everytime I try to go into the directory.

My solution is to move every file in a folder by the first letter of the file name.

In other words, move all the files a*.* to C:\MYFILES\A and move b*.* to C:\MYFILES\B

I suppose I could write a 26 line batch script, one for every letter, and maybe another for characters and 10 more for numbers...but maybe somebody knows a cleaner way to do this?
0
Comment
Question by:DVation191
  • 6
  • 5
  • 4
15 Comments
 
LVL 1

Expert Comment

by:Lycaon
ID: 13785319
Here's a possible solution.  Still a bit bulky, but it's still shorter, and reusable.

Sub SortFolder(sFolder As String) ' sFolder MUST end in a "\"
Dim x As Integer, Files() As String, Folder As String, CurrentFile As String

        ' Create all folders first, a-z
        For x = Asc("a") To Asc("z")
            Directory.CreateDirectory(sFolder & Chr(x) & "\")
        Next

        ' Create numbered folders, 0-9
        For x = 0 To 9
            Directory.CreateDirectory(sFolder & CStr(x) & "\")
        Next

        ' Create a folder for any non-number, non-alpha file (!, @, etc)
        Directory.CreateDirectory(sFolder & "Misc\")

        Files = Directory.GetFiles(sFolder) ' Gets all files.  The entire path of the file is returned in an array, one path+file per spot

        For x = 0 To Files.Length - 1 ' Loop through all files
            CurrentFile = Files(x).Substring(Files(x).LastIndexOf("\") + 1) ' Finds the last "\" in the path and extracts the filename from it
            Folder = CurrentFile.Substring(0, 1) ' Get the first character of the file, used to sort into folders

            Select Case Folder.ToLower  ' Decide based on the first character of the filename

                Case "a" To "z", "0" To "9" ' Move to the correct folder
                    File.Move(Files(x), sFolder & Folder & "\" & CurrentFile)

                Case Else
                    File.Move(Files(x), sFolder & "Misc\" & CurrentFile)

            End Select

        Next
End Sub
0
 
LVL 1

Expert Comment

by:Lycaon
ID: 13785330
Oh, the case else is to deal with any file that does not start with a letter or number
0
 
LVL 1

Expert Comment

by:Lycaon
ID: 13785393
Ack, I also forgot to mention you'll need to import System.IO :x
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
LVL 20

Author Comment

by:DVation191
ID: 13785456
" Ack, I also forgot to mention you'll need to import System.IO :x"
> I'm afriad I don't know how to do that....can you explain?
0
 
LVL 1

Expert Comment

by:Lycaon
ID: 13785457
I'm sorry DVation191, I thought I was looking in the VB.NET section.  That' won't work as a regular script :|
0
 
LVL 20

Author Comment

by:DVation191
ID: 13785524
that explains this error...
lol...oh well...it looked so promising...wanna compile it into an exe and send it to me? lol

rename.vbs(1, 24) Microsoft VBScript compilation error: Expected ')'
0
 
LVL 10

Expert Comment

by:ADSaunders
ID: 13788716
Hi DVation191 ,
This is a vbscript to do what you want, just copy & paste into a .vbs file (e.g. MoveFiles.vbs) and run it.

Regards .. Alan

private const SourcePath = "c:\" ' put your source directory here
private const DestPath = "c:\ByAlpha\" ' put your destination directory here
private sub HandleFile (byval f)
Dim init
      ' Get the fist letter of the name (Doesn't matter what it is as long as it's printable)
      init = left(f.name, 1)
  'check whether the folder exists
      if not fso.FolderExists(DestPath & init) then
            fso.createfolder(DestPath & init)
      end if
      ' If SourcePath and Destpath are on the same volume, or if the OS supports moving across volumes
      fso.MoveFile f.Path, DestPath & init
      ' Otherwise you might need:
      ' Fso.CopyFile f.Path, DestPath & init
      ' Fso.DeleteFile f.Path
end sub

Private Sub handlefolder(ByVal folder)
' Only need this to recurse subdirectories in the source path
'  For Each f In folder.SubFolders ' may not be necessary if there are no subfoldrs to recurse
'    handlefolder  f               '   ''          ''
'  Next                            '   ''          ''
  for each f in folder.files
    handlefile f
  next
End Sub

' Main Routine starts here
Dim fso, fo, fw, fr, glub
Set fso = CreateObject("Scripting.filesystemobject")
' Get handle to input folder
Set fo = fso.GetFolder(SourcePath)
handlefolder fo
Set fso = Nothing
Set fo = Nothing
0
 
LVL 10

Expert Comment

by:ADSaunders
ID: 13788728
Hi,
You can't tell this was hacked from another script can you? .. You don't need the dim's for  fw, fr, glub, only Dim fso, fo.
Sorry

.. Alan
0
 
LVL 20

Author Comment

by:DVation191
ID: 13790393
I edited the script accordingly....

private const SourcePath = "C:\DOWNLOADS\Font Collection\Copy of OpenType Fonts" ' put your source directory here
private const DestPath = "C:\DOWNLOADS\Font Collection\Copy of OpenType Fonts\Alpha" ' put your destination directory here
private sub HandleFile (byval f)
Dim init
     ' Get the fist letter of the name (Doesn't matter what it is as long as it's printable)
     init = left(f.name, 1)
  'check whether the folder exists
     if not fso.FolderExists(DestPath & init) then
          fso.createfolder(DestPath & init)
     end if
     ' If SourcePath and Destpath are on the same volume, or if the OS supports moving across volumes
     fso.MoveFile f.Path, DestPath & init
     ' Otherwise you might need:
     ' Fso.CopyFile f.Path, DestPath & init
     ' Fso.DeleteFile f.Path
end sub

Private Sub handlefolder(ByVal folder)
' Only need this to recurse subdirectories in the source path
'  For Each f In folder.SubFolders ' may not be necessary if there are no subfoldrs to recurse
'    handlefolder  f               '   ''          ''
'  Next                            '   ''          ''
  for each f in folder.files
    handlefile f
  next
End Sub

' Main Routine starts here
Dim fso, fo
Set fso = CreateObject("Scripting.filesystemobject")
' Get handle to input folder
Set fo = fso.GetFolder(SourcePath)
handlefolder fo
Set fso = Nothing
Set fo = Nothing


However it generates an error I can't debug.
"rename.vbs(12, 6) Microsoft VBScript runtime error: File already exists"
0
 
LVL 10

Expert Comment

by:ADSaunders
ID: 13790452
Hi,
>private const SourcePath = "C:\DOWNLOADS\Font Collection\Copy of OpenType Fonts" ' put your source directory here
>private const DestPath = "C:\DOWNLOADS\Font Collection\Copy of OpenType Fonts\Alpha" ' put your destination directory here

You're missing the trailing '\' on the paths!

.. Alan
0
 
LVL 20

Author Comment

by:DVation191
ID: 13790514
doh! sorry!

Ok I added the '\' at the end of the paths and ran it again. same error.

I tried deleting the 'C:\DOWNLOADS\Font Collection\Copy of OpenType Fonts\Alpha\' folder and ran it...got this error...
rename.vbs(9, 11) Microsoft VBScript runtime error: Path not found

So I'll assume  'C:\DOWNLOADS\Font Collection\Copy of OpenType Fonts\Alpha\' needs to be created...so I left Alpha there. But I'm still getting path not found errors...really sorry if I'm missing something stupid here!

Then i tried moving the rename.vbs to a directory outside of 'Copy of OpenType Fonts' and got this error...
rename.vbs(12, 6) Microsoft VBScript runtime error: File already exists

0
 
LVL 10

Expert Comment

by:ADSaunders
ID: 13790611
Hi,
A bit more .. I've actually run this now. Modify Sub HandleFile to the following: (as well as adding trailing '\' to the paths).

.. Alan

private sub HandleFile (byval f)
Dim init
     ' Get the fist letter of the name (Doesn't matter what it is as long as it's printable)
     init = left(f.name, 1)
     'check whether the folder exists
     if not fso.FolderExists(DestPath & init) then
          fso.createfolder(DestPath & init)
     end if
     ' If SourcePath and Destpath are on the same volume, or if the OS supports moving across volumes
     fso.MoveFile f.Path, DestPath & init & "\" & f.Name ' Seems FSO.MoveFile needs the actual file name, not just the path
     ' Otherwise you might need:
     ' Fso.CopyFile f.Path, DestPath & init
     ' Fso.DeleteFile f.Path
end sub
0
 
LVL 10

Accepted Solution

by:
ADSaunders earned 2000 total points
ID: 13790650
Yes, The dest root folder needs to exist. Here is my (fully working copy) of this script as it currently stands.

.. Alan

private const SourcePath = "c:\Downloads\planetsource\" ' put your source directory here
private const DestPath = "c:\Downloads\planetsource\ByAlpha\" ' put your destination directory here - Must already exist
private sub HandleFile (byval f)
Dim init
     ' Get the fist letter of the name (Doesn't matter what it is as long as it's printable)
     init = left(f.name, 1)
     'check whether the folder exists
     if not fso.FolderExists(DestPath & init) then
          fso.createfolder(DestPath & init)
     end if
     ' If SourcePath and Destpath are on the same volume, or if the OS supports moving across volumes
     fso.MoveFile f.Path, DestPath & init & "\" & f.Name
     ' Otherwise you might need:
     ' Fso.CopyFile f.Path, DestPath & init
     ' Fso.DeleteFile f.Path
end sub

Private Sub handlefolder(ByVal folder)
' Only need this to recurse subdirectories in the source path
'  For Each f In folder.SubFolders ' may not be necessary if there are no subfoldrs to recurse
'    handlefolder  f               '   ''          ''
'  Next                            '   ''          ''
  for each f in folder.files
    handlefile f
  next
End Sub

' Main Routine starts here
Dim fso, fo, fw, fr, glub
Set fso = CreateObject("Scripting.filesystemobject")
' Get handle to input folder
Set fo = fso.GetFolder(SourcePath)
handlefolder fo
Set fso = Nothing
Set fo = Nothing

0
 
LVL 20

Author Comment

by:DVation191
ID: 13790809
I ran it on two small font folders and it worked beautifully. I am running it on a folder now with over 30,000 files and its taking a while but working great....thanks!!!!
0
 
LVL 20

Author Comment

by:DVation191
ID: 13790865
could be tweaked just a hair (make all the characters of the folders created use uppercase instead of whatever the case is of the first letter in the alpha)....but otherwise it works flawlessly.

thanks!
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In real business world data are crucial and sometimes data are shared among different information systems. Hence, an agreeable file transfer protocol need to be established.
If you are a mobile app developer and especially develop hybrid mobile apps then these 4 mistakes you must avoid for hybrid app development to be the more genuine app developer.
In this fourth video of the Xpdf series, we discuss and demonstrate the PDFinfo utility, which retrieves the contents of a PDF's Info Dictionary, as well as some other information, including the page count. We show how to isolate the page count in a…
Six Sigma Control Plans

864 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