powered by simpleCommunicator - 2.0.53     © 2025 Programmizd 02
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Как перебрать все папки в текущем каталоге командой Dir
17 сообщений из 67, страница 3 из 3
Как перебрать все папки в текущем каталоге командой Dir
    #37980054
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
fel123,

Этот короткий код перечисляет все папки. Это не то, что нужно?

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
Option Explicit

Private mobjFSO As New FileSystemObject

Private Sub CommandButton1_Click()
    Dim objFolder As Folder
    
    Set objFolder = mobjFSO.GetFolder("C:\")
    GetSubFolders objFolder.Path
End Sub

Private Sub GetSubFolders(ByVal pstrFolder As String)
    
    Dim objFolder As Folder
    
    On Error Resume Next
    
    For Each objFolder In mobjFSO.GetFolder(pstrFolder).SubFolders
        Debug.Print objFolder.Path
        GetSubFolders objFolder.Path
    Next objFolder

End Sub
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37980123
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
fel123,

Этот код перечисляет все DCM файлы. Обратите внимание на отсутствие манипуляций со строковыми функциями.

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
Option Explicit

Private mobjFSO As New FileSystemObject
Private Const MY_ROOT As String = "G:\"
Private Const MY_DCM_File As String = "DCM File"

Private Sub CommandButton1_Click()
    GetSubFolders MY_ROOT
End Sub

Private Sub GetSubFolders(ByVal pstrFolder As String)
    
    Dim objFolder As Folder
    

    On Error Resume Next

    
    If pstrFolder = MY_ROOT Then
        Set objFolder = mobjFSO.GetFolder(pstrFolder)
        GetMyFiles objFolder
    End If
    

    For Each objFolder In mobjFSO.GetFolder(pstrFolder).SubFolders
        GetMyFiles objFolder
        GetSubFolders objFolder.Path
    Next objFolder

End Sub

Private Sub GetMyFiles(ByRef ioobjFolder As Folder)
    Dim objFile As File

    
    For Each objFile In ioobjFolder.Files
        If objFile.Type = MY_DCM_File Then
            Debug.Print objFile.Path
        End If
    Next objFile

End Sub
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37980126
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Но это тоже не фонтан, потому что рекурсии могут приводить к переполнению памяти.
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37980142
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
fel123,

Если нужен только один DCM файл, то:

Код: vbnet
1.
2.
            Debug.Print objFile.Path
            Exit For
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37980912
fel123
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
VladConn,

Полное имя файла ".dcm" = "D:\A\B\C\*.dcm". Написанный mds_world код со вставкой Казанского выдаёт список первых файлов ".dcm", которые содержатся в папке уровня С для каждой папки В. Мне же нужно для каждой папки В получить один-единственный файл. Поскольку я не знаю свойств FSO, т.е. не умею из каждой А вытащить одно имя В и из этой В вытащить одно С, то должен фильтровыть выход на уникальность В.
x = InStr(Nam, ":\") - разделитель D|A
y = InStr(x + 2, Nam, "\") - разделитель A|B
z = InStr(y + 1, Nam, "\") - разделитель B|C
Далее получаю имя папки В и храню его в глобальной переменной до следующего вызова рекурсии.
Относительно Immediate - при длинном списке мелькание на экране неприятно, а окно появляется после старта процедуры, т.е. как сделать выполнение невидимым?
Спасибо за подсказку!
P.s. Наверное, с Dir() или FindFirstFile было-бы проще - при первом вызове без аргументов они выдают первые имена. И второе - в стандарте DICOM для каждого исследования (Study) - своя папка А, для каждой прекции (Series) данного Study - своя папка B, для каждого слоя (Image) данной проекции - своя папка С. Image - файл ".dcm" - это картинка с преамбулой, которая мне, собственно, и нужна.
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37980920
fel123
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
fel123,

Извиняюсь, не обратил внимания, что вторая страница уже заполнена, поэтому не прочитал предыдущие сообщения.
Простите!
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37981046
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
fel123,

Попробуйте мой код с добавлением exit for. Он должен выдавать не больше одного DCM файла в каждом субфолдере любого заданного корневого фолдера.

Свойства же и методы FSO выпадают сами, если делать раннее связывание (в моем примере - раннее). Они все простые.
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37981048
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
fel123,

Debug.Print замените на добавление в какой-нибудь список, лист бокс, текст бокс.
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37981163
fel123
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
VladConn,

Ничего не изменяя, кроме "C:\" на "D:\A\", "с ходу" попробовал код 10522. Immediate осталось пустым. Буду разбираться - хотя код 15 работает, но появился спортивный интерес - может, начну разбираться в объектном программировании. До сих пор мне вполне хватало qBasic-a. И частный вопрос по VB6. В dir() рекурсия начинается со строчки "For A<>"." And A<>".." Then.....". По моему разумению, оба условия не могут появиться одновременно - они появляются при первом и втором проходе. Почему эта строчка всё-же работает? Получается, что я перестал понимать элементарную логику союза "и". Я пробовал заменять AND на OR но VB6 меня не понимает!
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37981185
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
fel123,

все правильно, ведь там сравнение "<>" а не "="
Согласно законам булевой алгебры это выражение можно переписать так
Код: vbnet
1.
Not (A="." Or A="..")

так понятнее?
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37982443
fel123
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro,

Спасибо, дошло!
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37982664
fel123
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
VladConn,

Попробовал проследить ход выполнения, но сразу споткнулся! Это

Private Sub CommandButton1_Click()
Debug.Print "A"
GetSubFolders MY_ROOT
End Sub

не работает. Если убрать Button, то "А" напечатается два раза, но больше в Immediate
ничего нет.
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37982671
катастрофа
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
fel123,
>Попробовал проследить ход выполнения
как через эф8? если так то без разницы как процедура называется, если нет как Вы интермедию видите? Зачем с интермедией экспериментируете?
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37982739
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
fel123VladConn,

Попробовал проследить ход выполнения, но сразу споткнулся! Это

Private Sub CommandButton1_Click()
Debug.Print "A"
GetSubFolders MY_ROOT
End Sub

не работает. Если убрать Button, то "А" напечатается два раза, но больше в Immediate
ничего нет.

CommandButton1 - это имя командной кнопки, которую я посадил на форму, чтобы можно было запустить код для Вас.

Нажал на кнопку - и кофемолка заработала. У Вас это может быть другая кнопка с другим именем, а может и не кнопка, а может не ворона.

Кнопки (а может и не кнопки) в VB обладают удивительной возможностью - событиями (собственно на этом и стоит мир и благополучие данного (и не только данного)) форума.

Нажатие кнопки на кофемолке (сорри, на форме) и есть событие. Оно отделено от имени кнопки знаком подчеркивания и называется (в данном примере) Click. Кликнул на кнопку - и это событие произошло. В коде оно выглядит как процедура. Если Вы в нее вставите какой-нибудь код, то этот код исполнится, но только если Вы кликнете на эту кнопку (иногда даже если не только кликнете).

Справедливости ради надо сказать, что разных-разных событий в языке VB - пруд пруди, так же как и имен различных кнопок (и не только кнопок), которые можно присваивать даже без священника.

: 0)


Пишите, если еще будут вопросы.
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37982749
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
fel123VladConn,

Попробовал проследить ход выполнения, но сразу споткнулся! Это

Private Sub CommandButton1_Click()
Debug.Print "A"
GetSubFolders MY_ROOT
End Sub

не работает. Если убрать Button, то "А" напечатается два раза, но больше в Immediate
ничего нет.

fel123,

У Вас значение MY_ROOT должно быть Ваше какое-то.
Вы его поставили в декларации этой константы или так и использовали моё наобум взятое ("G:\")?
Значение должно быть именем входного каталога, библейской праматери всех подкаталогов, растущих под нашим светилом и содержащих нужные Вам DCM файлы.
Может быть, ему подойдет значение "D:\". Попробуйте.
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37982768
fel123
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
VladConn,

Понял, что происходит. Если я, не меняя ничего, запускаю программу и смотрю на экран, то ничего и не вижу, поскольку идет обработка множества корневых папок диска С, что на экране не отражается. Только взглянув на блок и увидев, что трудится винчестер, я всй понял. Но на диске С нет ни одного файла ".dcm"!
Подождал 10 мин., индикатор мигает, программа на экран ничего не выдаёт. Понял, что так не пойдёт.
Сейчас прочитал в Google про кнопку. Ну не знал я раньше ничего про этот элемент, у меня ведь стандартный проект, стандартная форма и стандартный CommandBox! Я начинал экспериментировать с DriveListBox и т.д. , но понял, что для врачей это будет сложно - нужна готовая .exe, запустил и получил готовую таблицу. Буду работать с тем кодом, который работает.
Спасибо всем за потраченное на меня время!
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37982777
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
fel123VladConn,

Понял, что происходит. Если я, не меняя ничего, запускаю программу и смотрю на экран, то ничего и не вижу, поскольку идет обработка множества корневых папок диска С, что на экране не отражается. Только взглянув на блок и увидев, что трудится винчестер, я всй понял. Но на диске С нет ни одного файла ".dcm"!
Подождал 10 мин., индикатор мигает, программа на экран ничего не выдаёт. Понял, что так не пойдёт.
Сейчас прочитал в Google про кнопку. Ну не знал я раньше ничего про этот элемент, у меня ведь стандартный проект, стандартная форма и стандартный CommandBox! Я начинал экспериментировать с DriveListBox и т.д. , но понял, что для врачей это будет сложно - нужна готовая .exe, запустил и получил готовую таблицу. Буду работать с тем кодом, который работает.
Спасибо всем за потраченное на меня время!

Да все ОК. Главное не победа, главное участие. Спасибо Вам за код! Навернулись слезы, ностальгия по 60-м, знаете ли.

:0)

Я так и не понял, мой код для Вас работает или нет? Все дело в корневом каталоге, который Вы укажете для константы, это здорово сэкономит время.

Ничего плохого в том, что Вы не знакомы с VB, нет. Все всё понимают.

Удачи.
...
Рейтинг: 0 / 0
17 сообщений из 67, страница 3 из 3
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Как перебрать все папки в текущем каталоге командой Dir
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]