Move Folders To Subfolders Based On name

English support forum

Moderators: white, Hacker, petermad, Stefan2

Post Reply
User avatar
fidofido300
Junior Member
Junior Member
Posts: 23
Joined: 2003-07-28, 16:55 UTC

Move Folders To Subfolders Based On name

Post by *fidofido300 »

Hi
I am trying to group folders depending on their names first letter.
e.g
I have aaa-001, basd-009, hgh-991, zzzzz-0011 folders. When I am done I want to see
A-G\aaa-001
A-G\basd-009
H-L\hgh-991
M-R\
S-Z\zzzz-0011

Is there a way/tool to accomplish this???

Thanks In advance
User avatar
ZoSTeR
Power Member
Power Member
Posts: 1008
Joined: 2004-07-29, 11:00 UTC

Post by *ZoSTeR »

You can search with "RegEx" enabled for:

Code: Select all

^[a-g].*
and hit "Feed to Listbox".

Now move the found files to the target folder.

If this a recurring activity I would write a batch file or PowerShell script.
User avatar
fidofido300
Junior Member
Junior Member
Posts: 23
Joined: 2003-07-28, 16:55 UTC

Post by *fidofido300 »

Thank You
Is this gong to ratain folder structure or move all files into single directory
because I eant to move directories :)
and yes this is a recuring activity
:)
User avatar
Stefan2
Power Member
Power Member
Posts: 4133
Joined: 2007-09-13, 22:20 UTC
Location: Europa

Move Folders to sub folder // verschiebe Ordner in Unterordn

Post by *Stefan2 »

Sorry, didn't could resist.



Oh, english forum.... :(

well, just save this code as "move.vbs" in top main folder of your sub folders and double click it.

This script takes the very first char of each folder and move it to a new tidy up folder.

Test it with some test folders first...



Code: Select all

'/ VBScript: Verschiebe alle Unterordner anhand des ersten Zeichens in Unterordner
'/ Speichere diesen Code als "zzzVerschiebe.vbs" im Hauptordner der Unterordner.
'/ Zur Ausführung die Datei "zzzVerschiebe.vbs" doppelklicken.
'/ Teste zuerst mit ein paar Beispiel-Ordnern

Set FSO = CreateObject("Scripting.FileSystemObject")

MyWorkingFolder = FSO.GetParentFolderName(WScript.ScriptFullName)

'//------------------------------------------------------------------------
MB = MsgBox("Arbeitsordner:" & vbLF & MyWorkingFolder &"\" & vbLF & _
    "Unterordner jetzt verschieben?", vbOKCancel + vbQuestion, "Verschiebe in Unterordner")
    If (MB = vbCancel) Then WScript.Quit 

If Not FSO.FolderExists("A-G") Then FSO.CreateFolder "A-G"
If Not FSO.FolderExists("H-L") Then FSO.CreateFolder "H-L"
If Not FSO.FolderExists("M-R") Then FSO.CreateFolder "M-R"
If Not FSO.FolderExists("S-Z") Then FSO.CreateFolder "S-Z"
If Not FSO.FolderExists("0-9") Then FSO.CreateFolder "0-9"

WorkOnSubfolders FSO.GetFolder(MyWorkingFolder)
Sub WorkOnSubfolders (myMainFolder)
    For Each Subfolder in myMainFolder.SubFolders
        F = Subfolder.Name
        If Not(F="A-G" OR F="H-L" OR F="M-R" OR F="S-Z" OR F="0-9") Then 
            A = asc(ucase(left(F,1)))
            If(A>64 AND A<72) Then FSO.MoveFolder F , "A-G\" 
            If(A>71 AND A<77) Then FSO.MoveFolder F , "H-L\" 
            If(A>76 AND A<83) Then FSO.MoveFolder F , "M-R\" 
            If(A>82 AND A<91) Then FSO.MoveFolder F , "S-Z\" 
            If(A>47 AND A<58) Then FSO.MoveFolder F , "0-9\" 
        End If
    Next
End Sub
'//------------------------------------------------------------------------




HTH?
User avatar
fidofido300
Junior Member
Junior Member
Posts: 23
Joined: 2003-07-28, 16:55 UTC

Post by *fidofido300 »

Thanks
This is Doing exactliy what I want Can We make this to a botton on the buton bar which accepts %P ???

:)
User avatar
Stefan2
Power Member
Power Member
Posts: 4133
Joined: 2007-09-13, 22:20 UTC
Location: Europa

Post by *Stefan2 »

fidofido300 wrote:... Can We make this to a botton on the buton bar which accepts %P ???
- save code as zzz.VBS
- drag&drop VBS to buttonbar
- right click button > change >
Command= "d:\rive\path\zzz.vbs"
Parameters="%P"
Start path=
Icon file=wscript.exe
Tooltip=Move Sub folders to new created tidy up folder

Code: Select all

TOTALCMD#BAR#DATA
"D:\temp\TC move to subfolders by name\Move Sub folders to new created tidy up folder.vbs"
"%P"
C:\Windows\System32\WScript.exe,2
Move Sub folders to new created tidy up folder


-1
[H]: FAQs: Info about ''TOTALCMD#BAR#DATA'' Button code



the zzz.vbs

Code: Select all

'//  https://ghisler.ch/board/viewtopic.php?p=335872#335872

'/ VBScript: Verschiebe alle Unterordner anhand des ersten Zeichens in Unterordner
'/ Speichere diesen Code als "zzzVerschiebe.vbs" im Hauptordner der Unterordner.
'/ Zur Ausführung die Datei "zzzVerschiebe.vbs" doppelklicken.
Set FSO  = CreateObject("Scripting.FileSystemObject")

Set ARGs = WScript.Arguments
IF ARGs.count > 0 Then 
    MyWorkingFolder = ARGs(0)
Else
    MyWorkingFolder = FSO.GetParentFolderName(WScript.ScriptFullName)
End If

'//------------------------------------------------------------------------
MB = MsgBox("Arbeitsordner:" & vbLF & MyWorkingFolder & vbLF & _
    "Unterordner jetzt verschieben?", vbOKCancel + vbQuestion, "Verschiebe in Unterordner")
    If (MB = vbCancel) Then WScript.Quit 

If Not FSO.FolderExists("A-G") Then FSO.CreateFolder "A-G"
If Not FSO.FolderExists("H-L") Then FSO.CreateFolder "H-L"
If Not FSO.FolderExists("M-R") Then FSO.CreateFolder "M-R"
If Not FSO.FolderExists("S-Z") Then FSO.CreateFolder "S-Z"
If Not FSO.FolderExists("0-9") Then FSO.CreateFolder "0-9"

WorkOnSubfolders  FSO.GetFolder(MyWorkingFolder)
Sub WorkOnSubfolders (myMainFolder)
    For Each Subfolder in myMainFolder.SubFolders
        F = Subfolder.Name
        If Not(F="A-G" OR F="H-L" OR F="M-R" OR F="S-Z" OR F="0-9") Then 
            A = asc(ucase(left(F,1)))
            If(A>64 AND A<72) Then FSO.MoveFolder F , "A-G" 
            If(A>71 AND A<77) Then FSO.MoveFolder F , "H-L" 
            If(A>76 AND A<83) Then FSO.MoveFolder F , "M-R" 
            If(A>82 AND A<91) Then FSO.MoveFolder F , "S-Z" 
            If(A>47 AND A<58) Then FSO.MoveFolder F , "0-9" 
        End If
    Next
End Sub
'//------------------------------------------------------------------------




 
User avatar
fidofido300
Junior Member
Junior Member
Posts: 23
Joined: 2003-07-28, 16:55 UTC

Post by *fidofido300 »

Thank You Very Much

Code: Select all

'/ VBScript: Move all subfolders to subfolders using the first character
'/ Save this code as "move.vbs" in the main folder of the subfolders.
'/ To double-click the file "move.vbs".
'/ Test with a couple of sample folders first
'//  https://ghisler.ch/board/viewtopic.php?p=335872#335872 
'/ By Stefan2
Set FSO  = CreateObject("Scripting.FileSystemObject") 

Set ARGs = WScript.Arguments 
IF ARGs.count > 0 Then 
    MyWorkingFolder = ARGs(0) 
Else 
    MyWorkingFolder = FSO.GetParentFolderName(WScript.ScriptFullName) 
End If 

'//------------------------------------------------------------------------ 
MB = MsgBox("Working Folder:" & vbLF & MyWorkingFolder &"\" & vbLF & _ 
    "Move subfolders now?", vbOKCancel + vbQuestion, "Move to Subfolders") 
    If (MB = vbCancel) Then WScript.Quit 

If Not FSO.FolderExists("A-G") Then FSO.CreateFolder "A-G" 
If Not FSO.FolderExists("H-L") Then FSO.CreateFolder "H-L" 
If Not FSO.FolderExists("M-R") Then FSO.CreateFolder "M-R" 
If Not FSO.FolderExists("S-Z") Then FSO.CreateFolder "S-Z" 
If Not FSO.FolderExists("0-9") Then FSO.CreateFolder "0-9" 

WorkOnSubfolders FSO.GetFolder(MyWorkingFolder) 
Sub WorkOnSubfolders (myMainFolder) 
    For Each Subfolder in myMainFolder.SubFolders 
        F = Subfolder.Name 
        If Not(F="A-G" OR F="H-L" OR F="M-R" OR F="S-Z" OR F="0-9") Then 
            A = asc(ucase(left(F,1))) 
            If(A>64 AND A<72) Then FSO.MoveFolder F , "A-G\" 
            If(A>71 AND A<77) Then FSO.MoveFolder F , "H-L\" 
            If(A>76 AND A<83) Then FSO.MoveFolder F , "M-R\" 
            If(A>82 AND A<91) Then FSO.MoveFolder F , "S-Z\" 
            If(A>47 AND A<58) Then FSO.MoveFolder F , "0-9\" 
        End If 
    Next 
End Sub 
'//------------------------------------------------------------------------ 
Post Reply