Move Folders To Subfolders Based On name
Moderators: white, Hacker, petermad, Stefan2
- fidofido300
- Junior Member
- Posts: 23
- Joined: 2003-07-28, 16:55 UTC
Move Folders To Subfolders Based On name
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
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
You can search with "RegEx" enabled for:
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.
Code: Select all
^[a-g].*
Now move the found files to the target folder.
If this a recurring activity I would write a batch file or PowerShell script.
- fidofido300
- Junior Member
- Posts: 23
- Joined: 2003-07-28, 16:55 UTC
Move Folders to sub folder // verschiebe Ordner in Unterordn
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...
HTH?
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?
- fidofido300
- Junior Member
- Posts: 23
- Joined: 2003-07-28, 16:55 UTC
- save code as zzz.VBSfidofido300 wrote:... Can We make this to a botton on the buton bar which accepts %P ???
- 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
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
'//------------------------------------------------------------------------
- fidofido300
- Junior Member
- Posts: 23
- Joined: 2003-07-28, 16:55 UTC
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
'//------------------------------------------------------------------------