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

[Storlek]

Может кто знает???
Как во множестве директорий (например в трех сотнях) АВТОМАТИЧЕСКИ, средствами Total commander создать поддиректории с одинаковым названием?

[panda]

напиши батник. быстреее, чем с помощью TCScript

[YuG]

2Storlek
уточни, в каких директориях? одного уровня или нет? не совсем понятен вопрос...

[Storlek]

2YuG
Все директории(числом 360) одного уровня, лежат на одном винте в корне, нужно в каждой директории создать поддиректорию(History), в которую потом будут перемещены файлы превьюшек(*.jpeg) из директории(в самой директории останутся только рабочие файлы *.L1G или *.tif)

[YuG]

2Storlek
Понятно. Самое простое - создать макрос в FAR'e (время написания - 1 минута), а затем пробежаться по папкам (еще 1 минута).
Итого - 2 минуты.

Макрос в FAR'e - Enter F7 history Enter Home Enter Down ))

[Storlek]

2YuG
Эт еще прогу(FAR) ставииить, нееет "чем меньше деталей тем надежней система"!!!
Написали батник(слово то какое), он и папочки насоздавал и поперемещал все что нужно и куда нужна.
Но все равно обидна что в принципе такой симпатичный файловый менеджер не может сделать это как то по-проще.

[panda]

куда уж проще батника.

[Volniy]

А олени лучше.... (с)

Сохрани этот фрагмент в виде файла с раширением VBS.
Измени только сначала "A:" на правильное имя диска. Запускай!

===========
' (с) 2004, Volniy

Dim fso
Dim d, rf, sf
Set fso = CreateObject("Scripting.FileSystemObject")
Set d = fso.GetDrive("A:")
Set rf = d.RootFolder
For Each sf In rf.SubFolders
On Error Resume Next
sf.SubFolders.Add ("History")
Next
Set d = Nothing
Set rf = Nothing
Set fso = Nothing
============

Или я не прав?

[Magister]

2Volniy
Зашибись, скрипты рулят! Шустро работает!

[Storlek]

2Volniy
Спасибо!!! Есть правда на свете!
Для полного счастья остается только, что бы была возможность задавать не только диск, но и например общую директорию (где деньги дежат )?
ЗЫ: вот это был бы хит

[Volniy]

Если я правильно понял, то тогда достаточно заменить строки

Set d = fso.GetDrive("A:")
Set rf = d.RootFolder

на

Set rf = fso.GetFolder("C:\MoneyFolder")

а если нужно будет, как в старом варианте для всего диска, тогда просто укажешь на корневую директорию диска ("C:\") и все.

Если не оно, то уточни задачу, я дорисую.

[Storlek]

На всякий случай еще одна версия скрипта. В тех случаях если папки находятся не в корне диска, а в какой нибудь директории:
"c:\temp\ сменить на правильный путь"
_________________

Dim fso
Dim rf, sf
Set fso = CreateObject("Scripting.FileSystemObject")
Set rf = fso.GetFolder("c:\temp\")
For Each sf In rf.SubFolders
On Error Resume Next
sf.SubFolders.Add ("Название папки")
Next
Set rf = Nothing
Set fso = Nothing
Добавлено:
2volniy:
Что то у нас синхронно вышло )
На всякий случай спасибо, просто думал что ты не ответишь.

[Volniy]

<!--QuoteBegin-Storlek+Jun 18 2004, 18:06--></div><table border='0' align='center' width='95%' cellpadding='3' cellspacing='1'><tr><td>Цитата (Storlek @ Jun 18 2004, 18:06)</td></tr><tr><td id='QUOTE'><!--QuoteEBegin--> Что то у нас синхронно вышло )
На всякий случай спасибо, просто думал что ты не ответишь. <!--QuoteEnd--> </td></tr></table><div class='postcolor'> <!--QuoteEEnd-->
Просто перед уходом домой заглянул на форум

А вообще этот скрипт надо уже дополнить и теми делами, что там еще требовались (перенесение файлов в эти подпапки). Останется дописать всего-то пару строк.

BTW Вааще-то про скрипты тут где-то ниже тема была открыта

[Storlek]

<!--QuoteBegin--></div><table border='0' align='center' width='95%' cellpadding='3' cellspacing='1'><tr><td>Цитата </td></tr><tr><td id='QUOTE'><!--QuoteEBegin--> вообще этот скрипт надо уже дополнить и теми делами, что там еще требовались (перенесение файлов в эти подпапки). Останется дописать всего-то пару строк.<!--QuoteEnd--></td></tr></table><div class='postcolor'><!--QuoteEEnd-->

пару строк не удалось но для перемещения написали скрипт, иногда просто папки не нужно создавать.
так что если кому интересно:


Dim fso
Dim rf, sf, files, file
Set fso = CreateObject("Scripting.FileSystemObject")
Set rf = fso.GetFolder("c:\temp\")

For Each sf In rf.SubFolders
on error resume next
sfname = sf.path + "\"
dfname = sf.path + "\" + "History\"
fso.MoveFile sfname + "*.jpg", dfname
fso.MoveFile sfname + "*.met", dfname
fso.MoveFile sfname + "*.hdr", dfname
fso.MoveFile sfname + "*.ip3", dfname
Next
Set rf = Nothing
Set fso = Nothing


как обычно внутри все меняется на нужное

[Ti-Mac]

Ну вы даёте...