Автоматическое создание папок

[Flasher]

Сортировка по дате рулит.

[zlodei1988]

По теме созданию папок, есть ли возможность дописать какую то строку в код, чтобы только что созданные папки всегда были на виду! Когда создаешь папки, они доходят до нижнего уровня в ТС и создаются дальше, но их уже не видать( надо сделать так чтоб они всегда были на виду...

[Avada]

zlodei1988
Замечание за нарушение правил форума. На батник следовало дать ссылку (или попросить модератора помочь с этим), а не цитировать его целиком, да ещё в виде обычного текста. Выделять весь свой текст красным недопустимо. Пост отредактирован, убран ещё кое-какой мусор. Дубль прибит.
Что касается "папок на виду", то лично я, к сожалению, ничего не понял, но, может быть, кому-то повезёт больше.

[Tol!k]

zlodei1988
Сортировка папок

[Flasher]

Tol!k
Ты, в принципе, можешь добавить переход с TCMC.exe cds <путь к перемещённому файлу> "", если уж так человеку надо.

[BezDNaU]

Есть несколько текстовых файлов с путями:
CD 1.txt
CD 2.txt
CD 3.txt
CD 4.txt
CD 5.txt и т.д.
Содержимое приблизительно такое:
E:\VIDEO\Мульты\Советские\Советские\Ну погоди\01-nu.pogodi.01.avi
E:\VIDEO\Мульты\Советские\Советские\Ну погоди\02-nu.pogodi.02.avi
E:\VIDEO\Мульты\Советские\Советские\Ну погоди\03-nu.pogodi.03.avi
E:\VIDEO\Мульты\Советские\Советские\Ну погоди\04-nu.pogodi.04.avi
E:\VIDEO\Мульты\Советские\Советские\Ну погоди\05-nu.pogodi.05.avi
E:\VIDEO\Мульты\Советские\Советские\Ну погоди\06-nu.pogodi.06.avi
E:\VIDEO\Мульты\Советские\Советские\Ну погоди\07-nu.pogodi.07.avi
E:\VIDEO\Мульты\Советские\Советские\Ну погоди\08-nu.pogodi.08.avi
E:\VIDEO\Мульты\Советские\Советские\Ну погоди\09-nu.pogodi.09.avi
E:\VIDEO\Мульты\Советские\Советские\Ну погоди\10-nu.pogodi.10.avi
E:\VIDEO\Мульты\Советские\Советские\Ну погоди\11-nu.pogodi.11.avi
E:\VIDEO\Мульты\Советские\Советские\Ну погоди\12-nu.pogodi.12.avi
E:\VIDEO\Мульты\Советские\Советские\Ну погоди\13-nu.pogodi.13.avi
E:\VIDEO\Мульты\Советские\Советские\Ну погоди\14-nu.pogodi.14.avi
E:\VIDEO\Мульты\Советские\Советские\Ну погоди\15-nu.pogodi.15.avi
E:\VIDEO\Мульты\Советские\Советские\Ну погоди\16-nu.pogodi.16.avi
E:\VIDEO\Мульты\Советские\Советские\Ну погоди\17-nu.pogodi.17.avi
E:\VIDEO\Мульты\Советские\Советские\Ну погоди\18-nu.pogodi.18.avi
E:\VIDEO\Мульты\Советские\Советские\Леопольд\01-leopold.progulka.kota.leopolda.avi
E:\VIDEO\Мульты\Советские\Советские\Леопольд\02-leopold.televizor.kota.leopolda.avi
E:\VIDEO\Мульты\Советские\Советские\Леопольд\03-leopold.poliklinika.kota.leopolda.avi
E:\VIDEO\Мульты\Советские\Советские\Леопольд\04-leopold.leto.kota.leopolda.avi
E:\VIDEO\Мульты\Советские\Советские\Леопольд\05-leopold.kot.leopold.vo.sne.i.nayavu.avi
E:\VIDEO\Мульты\Советские\Советские\Леопольд\06-leopold.klad.kota.leopolda.avi
E:\VIDEO\Мульты\Советские\Советские\Леопольд\07-leopold.avtomobil.kota.leopolda.avi
E:\VIDEO\Мульты\Советские\Советские\Леопольд\08-leopold.den.rozhdenia.kota.leopolda.avi
E:\VIDEO\Мульты\Советские\Советские\Леопольд\09-leopold.i.zolotaya.rybka.avi
E:\VIDEO\Мульты\Советские\Советские\Леопольд\10-leopold.mest.kota.leopolda.avi
E:\VIDEO\Мульты\Советские\Советские\Леопольд\11-leopold.interview.avi
E:\VIDEO\Мульты\Советские\Советские\Трое из Простоквашино\Зима в Простоквашино.avi
E:\VIDEO\Мульты\Советские\Советские\Трое из Простоквашино\Каникулы в Простоквашино.avi
E:\VIDEO\Мульты\Советские\Советские\Трое из Простоквашино\Трое из Простоквашино.avi
E:\VIDEO\Мульты\Советские\Советские\Девочка и слон .avi

Нужно создать папки с именем txt файла (папка CD 1 для файла CD 1.txt и т.д.) и переместить в них файлы из списка с сохранением подкаталогов (папки не выделенные жирным).
Можно ли такое провернуть?
Заранее спасибо за помощь.

[mod="Avada"]Переносится в уже имеющуюся тему.[/mod]

[Flasher]

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

'======================================================================
' Перемещать файлы и папки, указанные в файлах-списках
' в папки с базовыми именами этих файлов-списков
' Параметры: %L <путь_назначения\>
' Пример: %L "%T"
'======================================================================
L = vbNewLine
D = InputBox(L&L&L&"Введите число отсекаемых компонентов " & L &_
"в началах путей, записанных" & L & "в выделенные файлы :",_
Space(13) & "Перемещение файлов и папок по спискам") 
If Trim(D) = "" Or Not IsNumeric(D) Then Wscript.Quit

With CreateObject("Scripting.FileSystemObject")
  Set TF = .OpenTextFile(WScript.Arguments(0), 1)
  Do While Not TF.AtEndOfStream
    F = TF.ReadLine
    If F > vbNullString And .FileExists(F) Then
      Trg = WScript.Arguments(1) & .GetBaseName(F)
      If Not .FolderExists(Trg) Then .CreateFolder Trg
      For Each Fn in Split(.OpenTextFile(F, 1).ReadAll, vbNewLine)
        Fn = Trim(Fn)
        If Fn <> "" And Mid(Fn, 2, 1) = ":" Then
          Fx = Fn
          Do While Abs(D) =< Abs(Ubound(Split(Fx, "\")))
            Fx = .GetParentFolderName(Fx)
          Loop
          FPath = Trg & "\" & .GetParentFolderName(Mid(Fn, Len(Fx)+2))
          If Not .FolderExists(FPath) Then .CreateFolder FPath
          If .FolderExists(Fn) Then .GetFolder(Fn).Move FPath & "\"
          If .FileExists(Fn) Then .GetFile(Fn).Move FPath & "\"
        End If
      Next
    End If
  Loop
  TF.Close
End With

[Batya]

Уже было.

[Flasher]

Так и знал, что было, только сделать было быстрей, чем искать.

[BezDNaU]

Спасибо но не совсем то.
Скрипт копирует файлы без сохранения подкаталогов т.е. для указанного примера должно получиться так:
CD 1\
-Ну погоди\
--01-nu.pogodi.01.avi
--02-nu.pogodi.02.avi
--03-nu.pogodi.03.avi
--04-nu.pogodi.04.avi
--05-nu.pogodi.05.avi
--06-nu.pogodi.06.avi
--07-nu.pogodi.07.avi
--08-nu.pogodi.08.avi
--09-nu.pogodi.09.avi
--10-nu.pogodi.10.avi
--11-nu.pogodi.11.avi
--12-nu.pogodi.12.avi
--13-nu.pogodi.13.avi
--14-nu.pogodi.14.avi
--15-nu.pogodi.15.avi
--16-nu.pogodi.16.avi
--17-nu.pogodi.17.avi
--18-nu.pogodi.18.avi
-Леопольд\
--01-leopold.progulka.kota.leopolda.avi
--02-leopold.televizor.kota.leopolda.avi
--03-leopold.poliklinika.kota.leopolda.avi
--04-leopold.leto.kota.leopolda.avi
--05-leopold.kot.leopold.vo.sne.i.nayavu.avi
--06-leopold.klad.kota.leopolda.avi
--07-leopold.avtomobil.kota.leopolda.avi
--08-leopold.den.rozhdenia.kota.leopolda.avi
--09-leopold.i.zolotaya.rybka.avi
--10-leopold.mest.kota.leopolda.avi
--11-leopold.interview.avi
-Трое из Простоквашино\
--Зима в Простоквашино.avi
--Каникулы в Простоквашино.avi
--Трое из Простоквашино.avi
-Девочка и слон .avi

[Batya]

Flasher
Не проверял твой скрипт, но, по крайней мере, BezDNaU хотел не копировать, а перемещать. Поправь.

[Flasher]

Batya

переместить в них файлы из списка

Не из папок.

BezDNaU
Да, я вот только сам заметил. Тогда нужно прояснить критерий обрезания. Либо по номеру компонента в заданном пути, либо глубине вложенности. Как лучше?

[BezDNaU]

Скорее по глубине вложенности.

[Flasher]

BezDNaU
Боюсь, что с глубиной вложенности не получится, т.к. она разная:

E:\VIDEO\Мульты\Советские\Советские\Трое из Простоквашино\Трое из Простоквашино.avi
E:\VIDEO\Мульты\Советские\Советские\Девочка и слон .avi

Сделаю по номеру компонента.

[Batya]

Сначала неверно понял задачу.

Сделал с перемещением с родительской папкой (глубина вложенности = 1):

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

'=====================================================================
' Создание папки по имени файла-списка и перемещение в нее файлов
' из файла-списка с родительской папкой.

' Параметры:
' {файл-список} {целевая папка}
'=====================================================================
Option Explicit
Dim FSO, FileList, TargetDir, F, FF

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

FileList  = WScript.Arguments(0)
TargetDir = WScript.Arguments(1)
If Right(TargetDir, 1) <> "\" Then TargetDir = TargetDir & "\"
Set FSO   = CreateObject("Scripting.FileSystemObject")
TargetDir = TargetDir & FSO.GetBaseName(FileList) & "\"

With FSO.OpenTextFile(FileList, 1)
  Do While Not .AtEndOfStream
    F = Trim(.ReadLine)
    If F <> "" And FSO.FileExists(F) Then
      FF = TargetDir & FSO.GetFileName(FSO.GetParentFolderName(F)) & "\"
      CreateFolder FF
      FSO.MoveFile F, FF
    End If
  Loop
  .Close
End With

MsgBox "Выполнено!", vbOKOnly + vbInformation, "Результат"
Set FSO = Nothing
Wscript.Quit

Sub CreateFolder(pFolder)
  Dim lParentFolder
  If Not FSO.FolderExists(pFolder) Then
    lParentFolder = FSO.GetParentFolderName(pFolder)
    If Not FSO.FolderExists(lParentFolder) Then CreateFolder(lParentFolder)
    FSO.CreateFolder(pFolder)
  End If
End Sub