' Создание папки по имени файла и перемещение в нее файла
' Может быть выделено несколько файлов
' Для создания папок в текущей панели
'   в параметрах вызова из TC должно быть прописано:
' %L
' Для создания папок в противоположной панели
'   в параметрах вызова из TC должно быть прописано:
' %L "%T"
' основан на коде Batya
'=====================================================================
If WScript.Arguments.Count = 0 Then
MsgBox "Нужны такие параметры:" + vbNewLine + vbNewLine + "%L" + vbNewLine + vbNewLine + "Или такие параметры:" + vbNewLine + vbNewLine + "%L ""%T""", vbOKOnly + vbError, "No Parameteres"
Wscript.Quit
End If
Dim TempFile, FSO, SelFile
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TempFile = FSO.OpenTextFile(WScript.Arguments(0), 1)
Name = InputBox("Введите количество символов", "Input", 10)
If Name = "" Then
Wscript.Quit
End If
Dim FileName, FilePath, DashInName, NewFilePath
Do While Not TempFile.AtEndOfStream
Set SelFile = FSO.GetFile(TempFile.ReadLine)
FileName = FSO.GetBaseName(SelFile)
FilePath = SelFile.ParentFolder
LName = (Left(FileName, Name))
If WScript.Arguments.Count > 1 Then
NewFilePath = WScript.Arguments(1) & LName
Else
NewFilePath = FilePath & "\" & LName
End If
If Not FSO.FolderExists(NewFilePath) Then
FSO.CreateFolder(NewFilePath)
End If
If Not FSO.FileExists(NewFilePath & "\" & FileName & "." & FSO.GetExtensionName(SelFile)) Then
FSO.MoveFile SelFile, NewFilePath & "\"
Else
MsgBox "Files Already Exist", vbOKOnly + vbError, "Error"
End If
Loop
Set TempFile = Nothing : Set FSO = Nothing : Set SelFile = Nothing : Wscript.Quit

'================================== VBS ================================
' Перемещение выбранных файлов в создаваемые при необходимости каталоги
' с тем же базовым именем или его частью, заданной регулярным выражением

' Параметры: %WL "<путь получателя>" <регулярное выражение>

' Условие: искомая часть в регулярном выражении записывается в скобках.
' Если второй параметр не задан или пуст, то
' получателем будет родительский каталог файла.

' Примеры:   %WL "%T"  |  %WL "" ^(\d+\.\d+\.\d+)  |  %WL "%T" (.{10})
'=======================================================================

Set A = WSH.Arguments : C = A.Count : If C = 0 Then WSH.Quit
Set FSO  = CreateObject("Scripting.FileSystemObject")
Set ShAp = CreateObject("Shell.Application")
Set List = FSO.OpenTextFile(A(0),,,-1)
If C = 3 Then _
Set Reg  = New RegExp : Reg.Global = True:_
Reg.IgnoreCase = True : Reg.Pattern = A(2)
Do : F = Trim(List.ReadLine)
  If FSO.FileExists(F) Then
    BN = FSO.GetBaseName(F)
    If IsObject(Reg) Then If Reg.Test(BN) Then _
    BN = Reg.Execute(BN)(0).Submatches(0) Else BN = ""
    If Len(BN) Then
      NF = "" : If C > 1 Then If A(1) <> "" Then NF = FSO.BuildPath(A(1),BN)
      If NF = "" Then NF = FSO.BuildPath(FSO.GetParentFolderName(F), BN)
      If Not FSO.FolderExists(NF) Then FSO.CreateFolder(NF)
      ShAp.NameSpace(NF).MoveHere F
    End If
  End If
Loop Until List.AtEndOfStream : List.Close

  If WScript.Arguments.Count > 1 Then
    NewFilePath = WScript.Arguments(1) & FileName
  Else
    NewFilePath = FilePath & "\" & FileName
  End If

  If WScript.Arguments.Count > 1 Then
    NewFilePath = WScript.Arguments(1) & Left(FileName, 10)
  Else
    NewFilePath = FilePath & "\" & Left(FileName, 10)
  End If