Создание каталога соответственно имени внутреннего каталога

[eldo]

Народ, подскажите как автоматизировать сей процесс
Имеется н-ное количество папок , все в одном каталоге. надо чтобы каждая папка оказалась в другой папке (уровнем ниже проще говря) с тем же именем папки что основная.
т.е. было
папкакорень ->подпапка X-> фалы
надо
папкакорень ->подпапка X->подпапка X-> фалы

Есть ли какая нибудь возможность не делать этого ручками ?
Заранее Благодарю.

[MVV]

Создай BAT-файл в папке, в которой нужно обработать подпапки, и запусти его из этой же папки:

Код: Выделить всё

@echo off
if not -%1==- goto go
for /d %%d in (*) do call %0 %%d
goto exit

:go
move %1 ~~%1~~
md %1
move ~~%1~~ %1\%1

:exit
cls

Скрипт обрабатывает папки последовательно, вначале временно приписывая к имени текущей папки ~~, а потом создавая новую папку с исходным именем и перемещая исходную папку внутрь вновь созданной, переименовывая ее обратно. Работает очень быстро, т.к. данные при этом не перемещаются, только элементы каталогов.

[Batya]

eldo
vbs-скрипт:

Код: Выделить всё

'=====================================================================
' Создание папки по имени родительской папки и перемещение в нее файла
' Может быть выделено несколько файлов

' Для создания папок в текущей панели
'   в параметрах вызова из TC должно быть прописано:
' %L

' Для создания папок в противоположной панели
'   в параметрах вызова из TC должно быть прописано:
' %L "%T"
'=====================================================================

If WScript.Arguments.Count = 0 Then
  MsgBox "Не указаны параметры!", vbOKOnly + vbError, "Внимание!"
  Wscript.Quit
End If

Dim TempFile, FSO, SelFile
Set FSO      = CreateObject("Scripting.FileSystemObject")
Set TempFile = FSO.OpenTextFile(WScript.Arguments(0), 1)

Dim FileName, FilePath, DashInName, NewFilePath
Do While Not TempFile.AtEndOfStream
  Set SelFile = FSO.GetFile(TempFile.ReadLine)
  FileName    = FSO.GetBaseName(SelFile)
  FilePath    = SelFile.ParentFolder
  If WScript.Arguments.Count > 1 Then
    NewFilePath = WScript.Arguments(1) & FSO.GetBaseName(FilePath)
  Else
    NewFilePath = FilePath & "\" & FSO.GetBaseName(FilePath)
  End If
  If Not FSO.FolderExists(NewFilePath) Then
    FSO.CreateFolder(NewFilePath)
  End If
  If Not FSO.FileExists(NewFilePath & "\" & FileName) Then
    FSO.MoveFile SelFile, NewFilePath & "\"
  Else
    MsgBox "Уже существует файл " & FileName & " в папке " & NewFilePath, vbOKOnly + vbExclamation, "Внимание!"
  End If
Loop
Set TempFile = Nothing
Set FSO      = Nothing
Set SelFile  = Nothing
Wscript.Quit

[DemoZluk]

А что нужно изменить в этом скрипте, чтобы все выделенные файлы поместились в одну папку с именем файла под курсором?

[Batya]

DemoZluk
Новый скрипт:

Код: Выделить всё

'===================================================================== 
' Создание папки по имени текущего файла с перемещением в неё
' выделенных файлов и папок

' Параметры:
' {файл-список} {файл, по которому формируется имя создаваемой папки}

' Примеры параметров при вызове из TC:
' %L %P%N
' %L %T%N
' %L %P%M
' %L %T%M
'===================================================================== 

Option Explicit
Dim FSO, FL, FF, F, NewPath, FullPath, Flag
With WScript
  If .Arguments.Count = 0 Then
    MsgBox "Не заданы параметры!"     , vbOKOnly + vbCritical, "Внимание!"
    .Quit
  End If
  If .Arguments.Count < 2 Then
    MsgBox "Указаны не все параметры!", vbOKOnly + vbCritical, "Внимание!"
    .Quit
  End If
  FL = .Arguments(0)
  FF = .Arguments(1)
End With

Set FSO = CreateObject("Scripting.FileSystemObject")
NewPath = FSO.GetParentFolderName(FF) & "\" & FSO.GetBaseName(FF) & "\"
If Not FSO.FolderExists(NewPath) Then FSO.CreateFolder(NewPath) 

With FSO.OpenTextFile(FL, 1)
  Do While Not .AtEndOfStream
    F = Trim(.ReadLine)
    If F <> "" Then
      If FSO.FolderExists(F) Then
        If Right(F, 1) = "\" Then F = Mid(F, 1, Len(F) - 1)
        Flag     = vbYes
        FullPath = NewPath & FSO.GetFileName(F)
        If FSO.FolderExists(FullPath) Then
          Flag = MsgBox("Папка """ & FullPath & """ уже существует! Заменить?", vbYesNoCancel + vbExclamation, "Внимание!")
          If Flag = vbCancel Then Wscript.Quit
          If Flag = vbYes    Then FSO.DeleteFolder(FullPath)
        End If
        If Flag = vbYes Then FSO.MoveFolder F, NewPath
      End If
      If FSO.FileExists(F) Then
        Flag     = vbYes
        FullPath = NewPath & FSO.GetFileName(F)
        If FSO.FileExists(FullPath) Then
          Flag = MsgBox("Файл """ & FullPath & """ уже существует! Заменить?", vbYesNoCancel + vbExclamation, "Внимание!")
          If Flag = vbCancel Then Wscript.Quit
          If Flag = vbYes    Then FSO.DeleteFile(FullPath)
        End If
        If Flag = vbYes Then FSO.MoveFile F, NewPath
      End If
    End If
  Loop
  .Close
End With

Set FSO = Nothing 
Wscript.Quit