Total Commander Forum Index Total Commander
Форум поддержки пользователей Total Commander
Сайты: Все о Total Commander | Totalcmd.net | Ghisler.com | RU.TCKB
 
 RulesRules   SearchSearch   FAQFAQ   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Нужен скрипт копирующий название всех папок в папке в txt

 
Post new topic   Reply to topic    Total Commander Forum Index -> Автоматизация Total Commander printer-friendly view
View previous topic :: View next topic  
Author Message
obuhov4



Joined: 03 Dec 2023
Posts: 1
Location: Варшава

Post (Separately) Posted: Sun Dec 03, 2023 22:06    Post subject: Нужен скрипт копирующий название всех папок в папке в txt Reply with quote

Помогите ребят, есть папка с 1000 подпапок , вот мне нужен скрипт который бы автоматически скопировал бы название всех папок в столбик в текстовый файл *list.txt
Back to top
View user's profile Send private message
Monarch-LFV



Joined: 22 Jul 2019
Posts: 239

Post (Separately) Posted: Mon Dec 04, 2023 07:09    Post subject: Reply with quote

obuhov4
Code:
' Создает файл-список всех папок и подпапок в выделенных директориях
' Параметр %WL
'=======================================================================================
On Error Resume Next
Dim FSO, spisok, List, F, subfolder, FldList, newLine
Set FSO = CreateObject("Scripting.FileSystemObject")
spisok = "C:\List.txt"
List = Split(FSO.OpenTextFile(WScript.Arguments(0),,,-1).ReadAll, vbNewLine)

For Each F In List
  If FSO.FolderExists(F) Then processDir(FSO.GetFolder(F))
Next

If FldList <> "" then
  Set ts = FSO.OpenTextFile(spisok, 2, True, -1)
    ts.Write FldList
  ts.Close
end if

Sub processDir(Object)
  if FldList <> "" then newLine = vbnewline
  FldList = FldList & newLine & FSO.GetFolder(Object).name
   For Each subfolder in Object.SubFolders
    processDir(subfolder)
   Next
End Sub

Код скрипта скопировать в файл script.VBS, этот файл поместить на панель кнопок и в параметрах указать %WL. Ну и если нужно указать свой путь сохранения файла в переменной spisok.

Добавлено спустя 59 минут:

Перечитал еще раз запрос, конечно же нужны уточнения, но мне кажется, что перемудрил в скрипте выше, список папок создается с рекурсией, то есть со всеми подпапками разной степени вложенности (надо ли было?).
Подумал, что все-таки нужен скрипт, который просто создает список папок в той же директории, где находимся, и только тех папок, которые расположены на данном уровне (без вложенности), то вот код:
Code:
' Создает файл-список всех папок в данной директории
' Параметр "%P"
'=======================================================================================
On Error Resume Next
Dim FSO, spisok, F, FldList, newLine
Set FSO = CreateObject("Scripting.FileSystemObject")
spisok = WScript.Arguments(0) & "\List.txt"

For Each F In FSO.GetFolder(WScript.Arguments(0)).subfolders
  If FSO.FolderExists(F) Then
    if FldList <> "" then newLine = vbnewline
    FldList = FldList & newLine & GetFolder(F).name
  end if
Next

If FldList <> "" then
  Set ts = FSO.OpenTextFile(spisok, 2, True, -1)
    ts.Write FldList
  ts.Close
end if

Обратить внимание на параметр: "%P" (в кавычках).
Back to top
View user's profile Send private message
Monarch-LFV



Joined: 22 Jul 2019
Posts: 239

Post (Separately) Posted: Tue Dec 05, 2023 03:23    Post subject: Reply with quote

По предложению откорректировал свой второй скрипт (действительно, проверка существования подпапки не нужна, так как итак имеется указание пробега циклом каждой подпапки, исключил ее):
Code:
' Создает файл-список всех папок в данной директории
' Параметр "%P"
'=======================================================================================
On Error Resume Next
Dim FSO, spisok, F, FldList, newLine, ts
Set FSO = CreateObject("Scripting.FileSystemObject")
spisok = WScript.Arguments(0) & "\List.txt"

For Each F In FSO.GetFolder(WScript.Arguments(0)).subfolders
  if FldList <> "" then newLine = vbnewline
  FldList = FldList & newLine & F.name
Next

If FldList <> "" then
  Set ts = FSO.OpenTextFile(spisok, 2, True, -1)
    ts.Write FldList
  ts.Close
end if


Также выкладываю не свою, но очень даже рабочую кнопку cmd (с помощью команды DIR создает такой файл-список моментально, в отличие от скрипта VBS, но создается в UTF-16 без BOM, а также появляется последняя пустая строка):
Code:
TOTALCMD#BAR#DATA
%comspec% /q/u/c dir/ad/b>Dirs.txt

%commander_exe%,24
Копировать имена всех подпапок папки активной панели в Dirs.txt

1
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    Total Commander Forum Index -> Автоматизация Total Commander All times are GMT + 4 Hours
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group