View previous topic :: View next topic |
Author |
Message |
obuhov4
Joined: 03 Dec 2023 Posts: 1 Location: Варшава
|
(Separately) Posted: Sun Dec 03, 2023 22:06 Post subject: Нужен скрипт копирующий название всех папок в папке в txt |
|
|
Помогите ребят, есть папка с 1000 подпапок , вот мне нужен скрипт который бы автоматически скопировал бы название всех папок в столбик в текстовый файл *list.txt |
|
Back to top |
|
|
Monarch-LFV
Joined: 22 Jul 2019 Posts: 240
|
(Separately) Posted: Mon Dec 04, 2023 07:09 Post subject: |
|
|
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 |
|
|
Monarch-LFV
Joined: 22 Jul 2019 Posts: 240
|
(Separately) Posted: Tue Dec 05, 2023 03:23 Post subject: |
|
|
По предложению откорректировал свой второй скрипт (действительно, проверка существования подпапки не нужна, так как итак имеется указание пробега циклом каждой подпапки, исключил ее):
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 |
|
|
|
|
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
|