?
Solved

Seperate each ext in different folders

Posted on 2007-07-31
15
Medium Priority
?
220 Views
Last Modified: 2010-05-18
Hi,

I want a script which can move files according to file ext.If jpg then a folder has to be created and all files to be moved to that folder.

Regards
Sharath
0
Comment
Question by:bsharath
  • 8
  • 4
  • 3
15 Comments
 
LVL 26

Expert Comment

by:Farhan Kazi
ID: 19606299
:: --------------------------------------
:: SCRIPT TO COUNT EACH TYPE OF EXT FILES
:: --------------------------------------
:: ===============
:: READ THIS FIRST
:: ===============
:: * Successful run will move files according to their file extension
:: * This script should be executed inside the folder
:: * Copy and paste following script in notepad and save it with "MoveExt.cmd" file name
:: *** SCRIPT START ***
@Echo Off
SetLocal EnableDelayedExpansion

SET LastExt=
FOR /F "delims=*" %%E IN ('Dir *.* /B /OE') DO (
      IF /I NOT "!LastExt!"=="%%~xE" (
      SET Ext=%%~xE
      SET Ext=!Ext:~1!
      IF NOT EXIST !Ext! MD "!Ext!"
      IF /I NOT "%%~nE%%~xE"=="MoveExt.cmd" (Move *.!Ext! "!Ext!")
      )  
      SET LastExt=%%~xE
)
:EndScript
ENDLOCAL
:: *** SCRIPT END ***
0
 
LVL 11

Author Comment

by:bsharath
ID: 19606423
It works small modification.In the main folder i have many folders within it.Can it even sort those folders
0
 
LVL 12

Expert Comment

by:zoofan
ID: 19606597
Hi,  This processed 5000 files totaling 1.01G in appox. 10 seconds.  Any files with more then one DOT in them only the furthest rightside dot is used for ext .  Files without an extension are placed in an a "unknown" directory.  All files will be renamed with a leading number starting at 0 and counting up for duplicate names.  Prompts for directory to start in and directory to place new folders/file in.

'===Start copy: movebyextension.vbs===
' ---------------------------------------------------------------'
' movebyextension.vbs
' 'Sample VBScript to move files in given folder
' 'to destitation folder by file extension.
' ''Author Riley C. aka ZooFan
' '''Version 1.8 - July 2007
' ''''www.experts-exchange.com question ID: 22733547
' ---------------------------------------------------------------'
'
    Option Explicit
    Dim strStartDir
    Dim strDestdir
    Dim objFso
    Dim objFolder
    Dim colfiles, objFile
    Dim Reslt
    Dim CntFile
    Dim ext
    Dim folderpath, fol, FolderName
    Dim strNewFilePath
    Set objFso = CreateObject("Scripting.FileSystemObject")
    strStartDir = InputBox("Enter the root starting folder.") & "\"
    strDestdir = InputBox("Enter the root destination folder.") & "\"
    movefiles(strStartDir)
    Reslt = RecursiveDir (strStartDir)
    Function RecursiveDir (path)

          Set folderpath = objFso.getfolder(path)
          Set fol = folderpath.SubFolders
          For Each Foldername In fol
                movefiles(FolderName & "\")
                RecursiveDir = FolderName
                RecursiveDir FolderName
          Next
    End Function
    WScript.Quit
 Sub movefiles(FolderName)
 Dim wExt
 On Error Resume Next
                            Set objFSO = CreateObject("Scripting.FileSystemObject")
                              Set objFolder = objFSO.GetFolder(FolderName)
                              Set colFiles = objFolder.Files
For Each objFile in colfiles
CntFile = 0
wExt = InStrRev(objFile.name, ".")
If wExt <> 0 Then
      wExt = Len(objfile.name) - wExt
      ext = Right(objfile.name,wExt)
      ext = LCase(ext)
      strNewFilePath = strDestdir & ext & "\"
      If Not objFso.FileExists(strNewFilePath & CntFile & objFile.name) Then
            If Not objFSO.FolderExists(strDestdir & "\" & ext) Then
                  objFSO.CreateFolder(strDestdir & "\" & ext)
                  objFso.MoveFile FolderName & objFile.name, strDestdir & "\" & ext & "\" & CntFile & objFile.name
            Else      
                  objFso.MoveFile FolderName &  objFile.name, strDestdir & "\" & ext & "\" & CntFile & objFile.name
            End If
      Else            
            Do Until not objFso.FileExists(strNewFilePath & CntFile & objFile.name)
                  CntFile = CntFile + 1
            Loop
            objFso.MoveFile FolderName & objFile.name, strDestdir & "\" & ext & "\" & CntFile & objFile.name                                                
      End If
Else
      If Not objFso.FileExists(strDestdir & "\unknown\" & CntFile & objFile.name) Then
            If Not objFSO.FolderExists(strDestdir & "\unknown") Then
                  objFSO.CreateFolder(strDestdir & "\unknown")
                  objFso.MoveFile FolderName & objFile.name, strDestdir & "\unknown"& "\" & CntFile & objFile.name
            Else
                  objFso.MoveFile FolderName & objFile.name, strDestdir & "\unknown\" & CntFile & objFile.name                                                                                    
            End if
      Else
            Do Until not objFso.FileExists(strDestdir & "\unknown\" & CntFile & objFile.name)
                  CntFile = CntFile + 1
            Loop
            objFso.MoveFile FolderName & objFile.name, strDestdir & "\unknown\" & CntFile & objFile.name                                                                                    
      End If
End If
Next
    End Sub
'===End copy: movebyextension.vbs===




zf

0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 12

Expert Comment

by:zoofan
ID: 19606601
And it does recusivly scan all folders down from the root starting point specified.

zf
0
 
LVL 11

Author Comment

by:bsharath
ID: 19606620
zoofan
Should i make any changes
I gave in the first box as
C:\dell
2nd box
C:\ext
Nothing happens
Am i doing something wrong
0
 
LVL 12

Expert Comment

by:zoofan
ID: 19606630
There is no progress meter, umm you may want to look in those folders in the ext destinations.

umm and dont put teh script in the source folder

zf
0
 
LVL 12

Expert Comment

by:zoofan
ID: 19606631
Will add a msgbox to the script notifing you when its done.
brb

zf
0
 
LVL 12

Expert Comment

by:zoofan
ID: 19606647
Added notice when complete and retested 9655 files 1750 folders 3.81G processed in 51 seconds


'===Start copy: movebyextension.vbs===
' ---------------------------------------------------------------'
' movebyextension.vbs
' 'Sample VBScript to move files in given folder
' 'to destitation folder by file extension.
' ''Author Riley C. aka ZooFan
' '''Version 1.8 - July 2007
' ''''www.experts-exchange.com question ID: 22733547
' ---------------------------------------------------------------'
'
    Option Explicit
    Dim strStartDir
    Dim strDestdir
    Dim objFso
    Dim objFolder
    Dim colfiles, objFile
    Dim Reslt
    Dim CntFile
    Dim ext
    Dim folderpath, fol, FolderName
    Dim strNewFilePath
    Set objFso = CreateObject("Scripting.FileSystemObject")
    strStartDir = InputBox("Enter the root starting folder.") & "\"
    strDestdir = InputBox("Enter the root destination folder.") & "\"
    movefiles(strStartDir)
    Reslt = RecursiveDir (strStartDir)
    Function RecursiveDir (path)

          Set folderpath = objFso.getfolder(path)
          Set fol = folderpath.SubFolders
          For Each Foldername In fol
                movefiles(FolderName & "\")
                RecursiveDir = FolderName
                RecursiveDir FolderName
          Next
    End Function
    MsgBox "All Files have been processed.",vbOKOnly,"Move files by extensions."
    WScript.Quit
 Sub movefiles(FolderName)
 Dim wExt
 On Error Resume Next
                            Set objFSO = CreateObject("Scripting.FileSystemObject")
                              Set objFolder = objFSO.GetFolder(FolderName)
                              Set colFiles = objFolder.Files
For Each objFile in colfiles
CntFile = 0
wExt = InStrRev(objFile.name, ".")
If wExt <> 0 Then
      wExt = Len(objfile.name) - wExt
      ext = Right(objfile.name,wExt)
      ext = LCase(ext)
      strNewFilePath = strDestdir & ext & "\"
      If Not objFso.FileExists(strNewFilePath & CntFile & objFile.name) Then
            If Not objFSO.FolderExists(strDestdir & "\" & ext) Then
                  objFSO.CreateFolder(strDestdir & "\" & ext)
                  objFso.MoveFile FolderName & objFile.name, strDestdir & "\" & ext & "\" & CntFile & objFile.name
            Else      
                  objFso.MoveFile FolderName &  objFile.name, strDestdir & "\" & ext & "\" & CntFile & objFile.name
            End If
      Else            
            Do Until not objFso.FileExists(strNewFilePath & CntFile & objFile.name)
                  CntFile = CntFile + 1
            Loop
            objFso.MoveFile FolderName & objFile.name, strDestdir & "\" & ext & "\" & CntFile & objFile.name                                                
      End If
Else
      If Not objFso.FileExists(strDestdir & "\unknown\" & CntFile & objFile.name) Then
            If Not objFSO.FolderExists(strDestdir & "\unknown") Then
                  objFSO.CreateFolder(strDestdir & "\unknown")
                  objFso.MoveFile FolderName & objFile.name, strDestdir & "\unknown"& "\" & CntFile & objFile.name
            Else
                  objFso.MoveFile FolderName & objFile.name, strDestdir & "\unknown\" & CntFile & objFile.name                                                                                    
            End if
      Else
            Do Until not objFso.FileExists(strDestdir & "\unknown\" & CntFile & objFile.name)
                  CntFile = CntFile + 1
            Loop
            objFso.MoveFile FolderName & objFile.name, strDestdir & "\unknown\" & CntFile & objFile.name                                                                                    
      End If
End If
Next
    End Sub
'===End copy: movebyextension.vbs===



zf
0
 
LVL 12

Expert Comment

by:zoofan
ID: 19606654
Did not add tests for the Source and Destination folders probably should have but....  So make sure both the source and destination folders exist.

Run a few tests and make sure you get it working,  then Ill add checks for the source and dest folders for a cleaner script.


zf

0
 
LVL 11

Author Comment

by:bsharath
ID: 19606729
Yes its working fine but its adding a "0" in each file after moving
0
 
LVL 12

Expert Comment

by:zoofan
ID: 19606745
Did you read my first script post?

"Any files with more then one DOT in them only the furthest rightside dot is used for ext .  Files without an extension are placed in an a "unknown" directory.  All files will be renamed with a leading number starting at 0 and counting up for duplicate names.  Prompts for directory to start in and directory to place new folders/file in."

This is the update script, adding tests for valid source and destination folders.  And also a test to make sure the script is not in the source directory.


'===Start copy: movebyextension.vbs===
' ---------------------------------------------------------------'
' movebyextension.vbs
' 'Sample VBScript to move files in given folder
' 'to destitation folder by file extension.
' ''Author Riley C. aka ZooFan
' '''Version 2.1 - July 2007
' ''''www.experts-exchange.com question ID: 22733547
' ---------------------------------------------------------------'
'
    Option Explicit
    Dim strStartDir
    Dim strDestdir
    Dim objFso
    Dim objFolder
    Dim colfiles, objFile
    Dim Reslt
    Dim CntFile
    Dim ext
    Dim folderpath, fol, FolderName
    Dim strNewFilePath
    Dim strCurPath
         On Error Resume next
    Set objFso = CreateObject("Scripting.FileSystemObject")
    strStartDir = InputBox("Enter the root starting folder.") & "\"
    strCurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
         If strStartDir = "\"Then
       MsgBox "You must enter a valid starting directory.",vbOKOnly,"Move files by extension"
            WScript.Quit
         End If
    MsgBox strCurPath & "    :    " & strStartDir
    If Not objFSO.FolderExists(strStartDir) Then
          MsgBox "You must enter a valid starting directory.",vbOKOnly,"Move files by extension"
          WScript.Quit
    Elseif Lcase(strStartDir) = Lcase((strCurPath & "\")) Then
                MsgBox "You can not run this script from the starting directory.",vbOKOnly,"Move files by extension"
                WScript.Quit
    Else
              strDestdir = InputBox("Enter the root destination folder.") & "\"
                         If strStartDir = "\"Then
                               MsgBox "You must enter a valid starting directory.",vbOKOnly,"Move files by extension"
                                    WScript.Quit
                           elseif Not objFSO.FolderExists(strDestdir) Then
                            MsgBox "You must enter a valid destination directory.",vbOKOnly,"Move files by extension"
                            WScript.Quit
                      End If
      End If
    movefiles(strStartDir)
    Reslt = RecursiveDir (strStartDir)
      MsgBox "All Files have been processed.",vbOKOnly,"Move files by extensions."      
WScript.Quit    
    Function RecursiveDir (path)

          Set folderpath = objFso.getfolder(path)
          Set fol = folderpath.SubFolders
          For Each Foldername In fol
                movefiles(FolderName & "\")
                RecursiveDir = FolderName
                RecursiveDir FolderName
          Next
    End Function
 Sub movefiles(FolderName)
 Dim wExt
 On Error Resume Next
                            Set objFSO = CreateObject("Scripting.FileSystemObject")
                              Set objFolder = objFSO.GetFolder(FolderName)
                              Set colFiles = objFolder.Files
For Each objFile in colfiles
CntFile = 0
wExt = InStrRev(objFile.name, ".")
If wExt <> 0 Then
      wExt = Len(objfile.name) - wExt
      ext = Right(objfile.name,wExt)
      ext = LCase(ext)
      strNewFilePath = strDestdir & ext & "\"
      If Not objFso.FileExists(strNewFilePath & CntFile & objFile.name) Then
            If Not objFSO.FolderExists(strDestdir & "\" & ext) Then
                  objFSO.CreateFolder(strDestdir & "\" & ext)
                  objFso.MoveFile FolderName & objFile.name, strDestdir & "\" & ext & "\" & CntFile & objFile.name
            Else      
                  objFso.MoveFile FolderName &  objFile.name, strDestdir & "\" & ext & "\" & CntFile & objFile.name
            End If
      Else            
            Do Until not objFso.FileExists(strNewFilePath & CntFile & objFile.name)
                  CntFile = CntFile + 1
            Loop
            objFso.MoveFile FolderName & objFile.name, strDestdir & "\" & ext & "\" & CntFile & objFile.name                                                
      End If
Else
      If Not objFso.FileExists(strDestdir & "\unknown\" & CntFile & objFile.name) Then
            If Not objFSO.FolderExists(strDestdir & "\unknown") Then
                  objFSO.CreateFolder(strDestdir & "\unknown")
                  objFso.MoveFile FolderName & objFile.name, strDestdir & "\unknown"& "\" & CntFile & objFile.name
            Else
                  objFso.MoveFile FolderName & objFile.name, strDestdir & "\unknown\" & CntFile & objFile.name                                                                                    
            End if
      Else
            Do Until not objFso.FileExists(strDestdir & "\unknown\" & CntFile & objFile.name)
                  CntFile = CntFile + 1
            Loop
            objFso.MoveFile FolderName & objFile.name, strDestdir & "\unknown\" & CntFile & objFile.name                                                                                    
      End If
End If
Next
    End Sub
'===End copy: movebyextension.vbs===




zf
0
 
LVL 12

Accepted Solution

by:
zoofan earned 1000 total points
ID: 19606768
Forgt to take out my testing message,   sorry...

'===Start copy: movebyextension.vbs===
' ---------------------------------------------------------------'
' movebyextension.vbs
' 'Sample VBScript to move files in given folder
' 'to destitation folder by file extension.
' ''Author Riley C. aka ZooFan
' '''Version 2.1 - July 2007
' ''''www.experts-exchange.com question ID: 22733547
' ---------------------------------------------------------------'
'
    Option Explicit
    Dim strStartDir
    Dim strDestdir
    Dim objFso
    Dim objFolder
    Dim colfiles, objFile
    Dim Reslt
    Dim CntFile
    Dim ext
    Dim folderpath, fol, FolderName
    Dim strNewFilePath
    Dim strCurPath
         On Error Resume next
    Set objFso = CreateObject("Scripting.FileSystemObject")
    strStartDir = InputBox("Enter the root starting folder.") & "\"
    strCurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
         If strStartDir = "\"Then
       MsgBox "You must enter a valid starting directory.",vbOKOnly,"Move files by extension"
            WScript.Quit
         End If
    If Not objFSO.FolderExists(strStartDir) Then
          MsgBox "You must enter a valid starting directory.",vbOKOnly,"Move files by extension"
          WScript.Quit
    Elseif Lcase(strStartDir) = Lcase((strCurPath & "\")) Then
                MsgBox "You can not run this script from the starting directory.",vbOKOnly,"Move files by extension"
                WScript.Quit
    Else
              strDestdir = InputBox("Enter the root destination folder.") & "\"
                         If strStartDir = "\"Then
                               MsgBox "You must enter a valid starting directory.",vbOKOnly,"Move files by extension"
                                    WScript.Quit
                           elseif Not objFSO.FolderExists(strDestdir) Then
                            MsgBox "You must enter a valid destination directory.",vbOKOnly,"Move files by extension"
                            WScript.Quit
                      End If
      End If
    movefiles(strStartDir)
    Reslt = RecursiveDir (strStartDir)
      MsgBox "All Files have been processed.",vbOKOnly,"Move files by extensions."      
WScript.Quit    
    Function RecursiveDir (path)

          Set folderpath = objFso.getfolder(path)
          Set fol = folderpath.SubFolders
          For Each Foldername In fol
                movefiles(FolderName & "\")
                RecursiveDir = FolderName
                RecursiveDir FolderName
          Next
    End Function
 Sub movefiles(FolderName)
 Dim wExt
 On Error Resume Next
                            Set objFSO = CreateObject("Scripting.FileSystemObject")
                              Set objFolder = objFSO.GetFolder(FolderName)
                              Set colFiles = objFolder.Files
For Each objFile in colfiles
CntFile = 0
wExt = InStrRev(objFile.name, ".")
If wExt <> 0 Then
      wExt = Len(objfile.name) - wExt
      ext = Right(objfile.name,wExt)
      ext = LCase(ext)
      strNewFilePath = strDestdir & ext & "\"
      If Not objFso.FileExists(strNewFilePath & CntFile & objFile.name) Then
            If Not objFSO.FolderExists(strDestdir & "\" & ext) Then
                  objFSO.CreateFolder(strDestdir & "\" & ext)
                  objFso.MoveFile FolderName & objFile.name, strDestdir & "\" & ext & "\" & CntFile & objFile.name
            Else      
                  objFso.MoveFile FolderName &  objFile.name, strDestdir & "\" & ext & "\" & CntFile & objFile.name
            End If
      Else            
            Do Until not objFso.FileExists(strNewFilePath & CntFile & objFile.name)
                  CntFile = CntFile + 1
            Loop
            objFso.MoveFile FolderName & objFile.name, strDestdir & "\" & ext & "\" & CntFile & objFile.name                                                
      End If
Else
      If Not objFso.FileExists(strDestdir & "\unknown\" & CntFile & objFile.name) Then
            If Not objFSO.FolderExists(strDestdir & "\unknown") Then
                  objFSO.CreateFolder(strDestdir & "\unknown")
                  objFso.MoveFile FolderName & objFile.name, strDestdir & "\unknown"& "\" & CntFile & objFile.name
            Else
                  objFso.MoveFile FolderName & objFile.name, strDestdir & "\unknown\" & CntFile & objFile.name                                                                                    
            End if
      Else
            Do Until not objFso.FileExists(strDestdir & "\unknown\" & CntFile & objFile.name)
                  CntFile = CntFile + 1
            Loop
            objFso.MoveFile FolderName & objFile.name, strDestdir & "\unknown\" & CntFile & objFile.name                                                                                    
      End If
End If
Next
    End Sub
'===End copy: movebyextension.vbs===


zf
0
 
LVL 26

Expert Comment

by:Farhan Kazi
ID: 19606811
:: ===============
:: READ THIS FIRST
:: ===============
:: * Successful run will move files according to their file extension
:: * This script should be executed inside the folder
:: * Copy and paste following script in notepad and save it with "MoveExt.cmd"
:: *** SCRIPT START ***
@Echo Off
SetLocal EnableDelayedExpansion
SET LastExt=

Call :MoveFiles %CD%
FOR /F "Delims=*" %%D IN ('Dir /S /AD /B /OE') DO (Call :MoveFiles %%D)
Goto :EndScript

:MoveFiles
CD "%1"
FOR /F "delims=*" %%F IN ('Dir *.* /B /OE') DO (
      IF /I NOT "!LastExt!"=="%%~xF" (
              IF NOT [%%~xF]==[] (
                      SET Ext=%%~xF
                      SET Ext=!Ext:~1!
                       IF NOT EXIST !Ext! MD !Ext!
                      IF /I NOT "%%~nF%%~xF"=="MoveExt.cmd" (Move *.!Ext! !Ext!)
                ))
        SET LastExt=%%~xF
)
:EndScript
ENDLOCAL
:: *** SCRIPT END ***
0
 
LVL 11

Author Comment

by:bsharath
ID: 19606853
Farhan

I tried but does not move the sub folders within the Main folder where the cmd file is present.
0
 
LVL 26

Assisted Solution

by:Farhan Kazi
Farhan Kazi earned 1000 total points
ID: 19607016
:: ===============
:: READ THIS FIRST
:: ===============
:: * Successful run will move files according to their file extension
:: * Copy and paste following script in notepad and save it with "MoveExt.cmd"
:: * This script should be executed with following syntax
::    MoveExt.cmd C:\FolderName  

:: *** SCRIPT START ***
@Echo Off
SetLocal EnableDelayedExpansion
IF [%1]==[] Goto :ShowUsage

CD "%1"
SET LastExt=
FOR /F "Delims=*" %%D IN ('Dir /S /AD /B /OE') DO (Call :MoveFiles %%D)
CD "%1"
Call :MoveFiles
Goto :EndScript

:MoveFiles
IF NOT [%1]==[] CD "%1"
FOR /F "delims=*" %%F IN ('Dir *.* /B /OE') DO (
      IF /I NOT "!LastExt!"=="%%~xF" (
              IF NOT [%%~xF]==[] (
                      SET Ext=%%~xF
                      SET Ext=!Ext:~1!
                      IF NOT EXIST !Ext! MD !Ext!
                      Move *.!Ext! !Ext!
              )
      )
      SET LastExt=%%~xF
)
Goto :EndScript
:ShowUsage
Echo Usage: MoveExt.cmd C:\FolderName
:EndScript
ENDLOCAL
:: *** SCRIPT END ***
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

This is my 3rd article on SCCM in recent weeks, the 1st (http://www.experts-exchange.com/OS/Microsoft_Operating_Systems/Server/Windows_Server_2008/A_4466-A-beginners-guide-to-installing-SCCM2007-on-Windows-2008-R2-Server.html) dealing with installat…
Welcome to my series of short tips on migrations. Whilst based on Microsoft migrations the same principles can be applied to any type of migration. My first tip Migration Tip #1 – Source Server Health can be found here: http://www.experts-exchang…
Windows 8 comes with a dramatically different user interface known as Metro. Notably missing from the new interface is a Start button and Start Menu. Many users do not like it, much preferring the interface of earlier versions — Windows 7, Windows X…
With the advent of Windows 10, Microsoft is pushing a Get Windows 10 icon into the notification area (system tray) of qualifying computers. There are many reasons for wanting to remove this icon. This two-part Experts Exchange video Micro Tutorial s…
Suggested Courses

839 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