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 

Single Post  Topic: Нужен скрипт копирующий название всех папок в папке в txt 
Author Message
Monarch-LFV



PostPosted: Mon Dec 04, 2023 08:08    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" (в кавычках).
View user's profile Send private message


Powered by phpBB © 2001, 2005 phpBB Group