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

Делаю так:
Код: plaintext
1.
2.
3.
4.
5.
6.
Dim tmp As String
tmp = Dir("d:\*.*")
Do While Len(tmp) >  0 
  tmp = Dir()
 Okno1.Text = Okno1.Text & tmp
Loop
Окно остается пустым!
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #35127040
Фотография klen_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
в справке написано, что это невозможно
Код: plaintext
1.
 you can't call the  Dir  function recursively.
Вы не можете вызвать функцию Dir рекурсивно
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #35127088
Dimon111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Не совсем так.

На данный момент удалось выяснить, что это

Код: plaintext
1.
2.
3.
4.
5.
6.
Dim tmp As String 
tmp = Dir("d:\", vbDirectory) 
Do While Len(tmp) >  0  
 Okno1.Text = Okno1.Text & tmp 
  tmp = Dir() 
Loop

Работает. Но папки, начинающиеся с цифры она не видит. Впрочем, и так годится, но хотелось бы узнать почему.
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #35127142
Фотография klen_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
пишут, что
"Рекуррентное применение Dir (в последующих вызовах уже без аргументов) используется только для перечисления файлов"
это из книги по VB 6.0
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #35127156
Фотография HandKot
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
вероятно у них атрибут не только "vbDirectory"

I Have Nine Lives You Have One Only
THINK!
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #35127209
Dimon111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Но это же работает:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
Dim Tmp As String, I As Integer, Kstr As String 
Tmp = Dir("D:\", vbDirectory) 
Do While Len(Tmp) >  0  
  ReDim Preserve DirArray(I) 
  DirArray(I) = Tmp 
  I = I +  1  
  Okno1.Text = Okno1.Text & Tmp + Chr( 13 ) + Chr( 10 ) 
  Tmp = Dir() 
Loop

Ошибка мной обнаружена: строку Tmp = Dir() нужно было поместить после запоминания первого элемента. Иначе первый путь (созданный строкой Tmp = Dir("D:\", vbDirectory)) просто не запоминался.

Попутно встал еще один вопрос: Как вместо пути Dir("d:\", vbDirectory) подставить текущий путь?
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #35127247
AndrF
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
klen_
"Рекуррентное применение Dir (в последующих вызовах уже без аргументов) используется только для перечисления файлов"
это из книги по VB 6.0

Как хорошо что я не читал таких книжек...
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #35127253
AndrF
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Dimon111
Попутно встал еще один вопрос: Как вместо пути Dir("d:\", vbDirectory) подставить текущий путь?

F1 и смотреть:

App.Path
CurDir
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #35127264
AndrF
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
klen_в справке написано, что это невозможно
Код: plaintext
1.
 you can't call the  Dir  function recursively.
Вы не можете вызвать функцию Dir рекурсивно


Для перебора файлов/папок не заходя в подкаталоги даром не нужен рекурсивный вызов чего либо.
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #35127333
Dimon111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Как обойтись без рекурсии?
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #35127400
Фотография klen_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
а книга называется Карoль "Справочник с примерами" Visual Basic 6.0 страница 81
далее автор книги пишет, что
"Однако перечислить, например субкаталоги данного каталога с помощью такого кода, как
Код: plaintext
1.
2.
3.
4.
5.
Dim sNextDir
Debug.Print Dir ("c:\windows\*", vbdirectory)
Do
   sNextDir = Dir
   Debug.Print sNextDir
Loop Until sNextDir = ""
нельзя. Вызовы Dir без аргументов будут возвращать подряд и файлы и каталоги.

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

Но можно проверить атрибут с помощью GetAttr и узнать что это: файл или каталог


I Have Nine Lives You Have One Only
THINK!
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #35129063
Dimon111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Как все - таки релизовать Dir из текущего катклога, чтобы не указывать конкретного пути?

App.Path, CurDir выдает лишь текущий рабочий каталог (папку в которой назодится программа): Dir(App.Path, vbDirectory).

Спасибо
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #35351820
UZER2006
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Недостаток/преимущество CurDir(), App.Path в том, что они возвращаю значения в формате "x:\<>foldername". Это есть адрес и имя конкретной папки, а не ссылка на ее "внутренности". :-)
Добавь к этому в вызове функции Dir символ "\" - и он уже работает внутри папки. :-)
Dir(CurDir()+"\")
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #35351866
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Чего-то не понял. Зачем вам рекурсии-то, раз в подкаталоги не заходите? Вот у вас:

" Нужно перебрать все папки в текущем каталоге не заходя в подкаталоги ..."
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #35351924
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
    Dim objFSO As New FileSystemObject
    Dim objFolder As Folder

    Set objFolder = objFSO.GetFolder("C:\")
    
    For Each objFolder In objFSO.GetFolder("C:\").SubFolders
        Debug.Print objFolder.Name
    Next objFolder
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #35353886
AndreyMp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Ну и на API
Код: plaintext
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.
43.
44.
45.
46.
47.
48.
49.
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Const MAX_PATH =  260 
Const INVALID_HANDLE_VALUE = - 1 
Const FILE_ATTRIBUTE_DIRECTORY = &H10

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String *  14 
End Type

Function FindFolderAPI(path As String)
    Dim DirName As String
    Dim i As Integer
    Dim hSearch As Long
    Dim WFD As WIN32_FIND_DATA
    Dim Cont As Integer
    
    If Right(path,  1 ) <> "\" Then path = path & "\"
    Cont = True
    hSearch = FindFirstFile(path & "*", WFD)
    If hSearch <> INVALID_HANDLE_VALUE Then
        Do While Cont
        DirName = WFD.cFileName
        If (DirName <> ".") And (DirName <> "..") Then
            If GetFileAttributes(path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
                List1.AddItem DirName
            End If
        End If
        Cont = FindNextFile(hSearch, WFD)
        Loop
        Cont = FindClose(hSearch)
    End If
End Function
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #35354751
AndrF
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
AndreyMpНу и на API

По скорости это, кстати, не отличается от Dir или FileSystemObject...
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #35354861
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Тут уместно вспомнить, что FileSystemObject и есть собрание всех этих API, удобное для потребления и позволяющее не мучиться с длинным и нетривильным для быстрого восприятия кодом.
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #35354977
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Несколько упрощу свой пример:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
    Dim objFSO As New FileSystemObject
    Dim objFolder As Folder

    Set objFolder = objFSO.GetFolder("C:\")
    
    For Each objFolder In objFolder.SubFolders
        Debug.Print objFolder.Name
    Next objFolder

Не считая описания переменных, всего четыре строчки, включая Debug.
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #35355019
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
> Автор: VladConn
> Несколько упрощу свой пример:
>
>
> Dim objFSO As New FileSystemObject
> 'Dim objFolder As Folder
Нет, ну если упрощать, так упрощать ;)
Эта строка не нужна, т.к нет проверки на валидность возвращаемого значения
> 'Set objFolder = objFSO.GetFolder("C:\")
>

И поэтому вызов можно подставить сразу в цикл
> For Each objFolder In objFSO.GetFolder("C:\").SubFolders
> Debug.Print objFolder.Name
> Next objFolder
> Не считая описания переменных, всего четыре строчки, включая Debug.

Получилось четыре считая объявление переменной. :)

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #35355057
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Угу! Тем более!

:0)
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #35355778
AndreyMp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
авторAndreyMp
Ну и на API

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

:0)
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #35358563
AndreyMp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Ну да, File System Object, конечно им .
...
Рейтинг: 0 / 0
Период между сообщениями больше года.
Как перебрать все папки в текущем каталоге командой Dir
    #37968556
fel123
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
AndreyMp,
objFSO As New FileSyste - не определён, и в references нет FSO!
Пожалуйста,дайте работающий код!
Если можно, помогите решить задачу:
Есть папка "А", содержащая только папки "В", содержащие файлы "С". Нужно в каждой "С"
вызвать первый файл для его обработки. Все имена - цифровые, тип файлов - ".dcm".
Спасибо.
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37968561
катастрофа
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
fel123,
> и в references нет FSO!
а скрин этого можно?
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37968756
fel123
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
катастрофа,
Вот всё,что там есть на "F".
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37969293
Фотография HandKot
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
fel123
А Вы поищите на "S"
Вас должно заинтересовать Microsoft Scripting Runtime
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37969863
Казанский
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Можно без FSO, с помощью консольной команды DIR. Пример тут, можно допилить под конкретную задачу:
http://www.cyberforum.ru/vba/thread645716-page2.html#post3413444

Нужно в каждой "С" вызвать первый файл для его обработки. " - Вы имеете в виду первый при сортировке по алфавиту, самый ранний или самый поздний файл? В любом случае, это решается ключом сортировки в команде DIR:

Код: plaintext
1.
2.
3.
  /O        Сортировка списка отображаемых файлов.
  порядок    N  По имени (алфавитная)       S  По размеру (сперва меньшие)
             E  По расширению (алфавитная)  D  По дате (сперва более старые)
             G  Начать список с каталогов   Префикс "-" обращает порядок

Ну а чтобы выделить только один файл из папки, можно сложить пути файлов в коллекцию, используя в качестве ключа путь к папке (т.е. путь файла до последнего "\").
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37970642
fel123
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Казанский,

Большое спасибо за помощь всем!
Я сделал с Dir, список всех подпапок создаётся, но не передаётся во вторую часть, попытка декларировать List1 As Control не проходит. Что можно сделать?

Dim X As String, A As String, i As Single, Z As String
Private Sub form_load()
i = 0
Y = "d:\A\"
X = Dir(Y, 16)
Do While Not X = ""
List1.List(i) = X + Chr(10)
X = Dir
i = i + 1
Loop
Form1.Visible = True
List1.Visible = True
k = i - 1
End Sub
Private Sub command1_click()
For k = 2 To i ' пропуск "." & ".."
Z = Y + List1.List(k)
G = Dir(Z, vbDirectory) 'Bad file namt or number
Next k
'передача файла на обработку
End Sub
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37970711
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
fel123,


Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
' никаких библиотек в референсах подключать не надо.
Dim fso As Object, objFolder As Object, SubFolder As Object
Dim sFileFullName As String

Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = fso.GetFolder("d:\A\")

For Each SubFolder In objFolder.SubFolders
    ' 'первый' файл .dcm в папке, *сортировка по имени*
    ' если нужно как-то иначе выбрать 'первый' файл, - подход должен быть другим...
    sFileFullName = SubFolder.Path & "\" & Dir(SubFolder.Path & "\*.dcm")
    Debug.Print sFileFullName
Next SubFolder

Set SubFolder = Nothing
Set objFolder = Nothing
Set fso = Nothing
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37970840
fel123
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Это уже было!
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37970862
Фотография mds_world
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
fel123Это уже было!


fel123, скажите, а весь этот код он в какой-нибудь процедуре записан? Или вот так как есть в разделе объявлений модуля?
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37970909
fel123
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Понял - нужно добавить sub form_load().
Код отлично работает.
СПАСИБО ВСЕМ!
Но у меня ещё вопрос по работе. Я вообще-то электронщик (военный), но с 69 года работаю в медицине. Программирую по необходимости. Ситуация такая: раньше eFilm создавал свои таблицы в acsses97, но в новой версии используется sql server 2005 express. Поскольку это форум sql, то прошу помочь мне прочитать таблицы этого sql.
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37970928
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Модератор: Создавайте отдельный топик
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37972130
fel123
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
mds_world,

Я рано обрадовался, но виноват сам - ошибся в постановке задачи.
На самом деле структура такая: папка A содержит папки B (Study), каждая B содержит папки C (Series), и только каждая C содержит файлы D (Images). Я помучился, добавил вторую часть кода, но не могу понять, почему вместо первого файла D, соответствующего папке A, получаю список всех D, соответствующих папке A. Т.е. во второй части кода не
проходит цикл по папкам A (цикл по i)? Уже мозги плавятся!
SOS!

Код: 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.
Sub Form_load()
Dim fso As Object, objFolder As Object, SubFolder As Object
Dim sFileFullName As String
Dim i As Integer
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = fso.GetFolder("d:\A\")
i = 0
For Each SubFolder In objFolder.SubFolders
    sFileFullName = SubFolder.Path & "\" & Dir(SubFolder.Path & "\*.dcm")
    List1.List(i) = sFileFullName
    i = i + 1
Next SubFolder
End Sub

Sub command1_click()
Dim fso As Object, objFolder As Object, SubFolder As Object
Dim sFileFullName As String
Set fso = CreateObject("Scripting.FileSystemObject")
For i = 0 To List1.ListCount
Set objFolder = fso.GetFolder(List1.List(i) & "\") '&#194;&#238;&#242; &#231;&#228;&#229;&#241;&#252; &#237;&#229; &#236;&#229;&#237;&#255;&#229;&#242;&#241;&#255; i
For Each SubFolder In objFolder.SubFolders
    sFileFullName = SubFolder.Path & "\" & Dir(SubFolder.Path & "\*.dcm")
    List2.List(i) = sFileFullName
    i = i + 1
Next SubFolder
Next i
Set SubFolder = Nothing
Set objFolder = Nothing
Set fso = Nothing
End Sub


Модератор: Учимся использовать тэги оформления кода - FAQ
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37972169
fel123
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
VladConn,
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37972214
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
fel123 , и каков вопрос?
Если про Dim ... as New ... , то видимо
HandKot fel123
А Вы поищите на "S"
Вас должно заинтересовать Microsoft Scripting Runtime
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37972233
Фотография mds_world
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
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.
24.
25.
26.
27.
28.
29.
30.
31.
32.
Option Explicit

Dim oFSO As Object
 
Sub Main()
    Const sPath As String = "d:\A\"
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Call recurse(sPath)
End Sub

Sub recurse(sPath As String)
 
    Dim oFolder As Object
    Dim oSubFolder As Object
    Dim oFile As Object
    
    Set oFolder = oFSO.GetFolder(sPath)
    
    'Здесь что-то делаем с файлами
    For Each oFile In oFolder.Files
        Debug.Print sPath & "\" & oFile.name 'Распечатка имен файлов
        '....................
    Next oFile
    
    'Просматриваем все подпапки внутри текущей папки.
    For Each oSubFolder In oFolder.SubFolders
        'Рекурсия - вызов функции самой собой же.
        Call recurse(oSubFolder.Path)
        Debug.Print "Folder - ", oSubFolder.Path 'распечатка подпапок
    Next oSubFolder
 
End Sub
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37974992
fel123
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
mds_world,

Привет!
Этот код выдаёт всё подряд: и файлы, и папки. Если закомментирова второй Debug.Print, то выдаются все файлы подпапок (С). Для работы мне нужно из каждой подпапки (B) исходной папки (А) по одному из множества файлов подпапок (C), т.е. каждой (B) cоответствует один файл. В GOOGLE нашел интересный момент:

For Each element [ As datatype ] In group
[ statements ]
[ Exit For ]
[ statements ]
Next [ element ]

Компоненты:
element
Обязателен в операторе For Each. Необязателен в операторе Next. Переменная. Используется для циклическогопрохода (итерации) элементов коллекции.
datatype
Обязателен, если еще не объявлен элемент element. Тип данных element.
group
Обязательный компонент. Объектная переменная. Указывает на коллекцию, применительно к элементам которой будут повторяться операторы statements.
statements
Необязательный компонент. Один или несколько операторов, стоящих между операторами For Each и Next и выполняющихся применительно к каждому элементу group.
Exit For
Необязательный компонент. Передача управления из цикла For Each.
Next
Обязательный компонент. Завершение определения цикла For Each.

Источник: http://msdn.microsoft.com/ru-ru/library/5ebk1751%28v=vs.90%29.aspx

По идее, нужно прерывать цикл по B, как только нашёлся первый ".dcm". Можно, конечно, сделать фильтр списка файлов на уникальность элемента B, но исполняемый код будет очень долго работать. А мне ещё файлы обработать нужно! Я пока не понимаю, как работают циклы в FSO, т.е. не знаю, как вставить Exit For. Если есть время, помогите!
Спасибо!
P.S. Пока писал, подумал, что, наверное, в цикле по oFile можно проверить атрибут, но есть-ли в FSO что-то типа File.Attribute.Name?
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37975189
Казанский
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Вот так эта часть
Код: vbnet
1.
2.
3.
4.
5.
6.
    For Each oFile In oFolder.Files
        If LCase(oFile.Name) Like "*.dcm" Then
            Debug.Print sPath & "\" & oFile.Name 'действие с файлом
            Exit For
        End If
    Next oFile
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37977167
fel123
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Казанский,

Доброго времени суток!
Спасибо за науку.
Только этот код выдает первые файлы всех подпапок последнего уровня, а нужно для каждой подпапки папки А только один файл. ОчевидноБ нужна внешняя процедура на уникальность имени подпапки В, что-то вроде
Sub Filtr(Spath,Z)
Const startB As String = ":\"
Const endB As String = "\"
x = InStr(sPath, startB)
y = InStr(sPath, endB)
Dim temrB As String
Dim temrorB As String
Mid(sPath, x, y - x) = tempB
If tempB <> temporB Then
tempB = temporB
Exit For (если внутри, или z=False, если Sub)
End If
End Sub
Я попытался так сделать, но запутался в логике. Как нужно?
Ещё раз благодарю ВАС!
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37977225
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Модератор: fel123,
еще раз предупреждаю про использование тэгов для оформления кода
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37977570
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
> fel123,
> На самом деле структура такая: папка A содержит папки B (Study), каждая B содержит папки C (Series), и только каждая C содержит файлы D (Images)

ох уж енти ваенныя електронщыки ...
могабукаф
Код: 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.
Sub Form_load()
  Dim fso As Object, objFolder As Object, SubFolder As Object
  Dim SubSubFolder As Object
  Dim sFileFullName As String
  Dim i As Integer

  Set fso = CreateObject("Scripting.FileSystemObject")
  Set objFolder = fso.GetFolder("d:\A\")

' !!! предупреждаю - путь тупиковый: SubSubSub..Folder-ов не напасёшься
' но, как ваирант 'надо на позавчера', с пивом покатит
  For Each SubFolder In objFolder.SubFolders               ' <-- enum B-folders
  For Each SubSubFolder In SubFolder.SubFolders            ' <-- enum C-folders
      ' 'первый' файл .dcm в папке, *сортировка по имени*
      ' если нужно как-то иначе выбрать 'первый' файл, - подход должен быть другим...
      sFileFullName = SubSubFolder.Path & "\" & Dir(SubSubFolder.Path & "\*.dcm")
      
      If Len(sFileFullName) > 0 Then 'так, 'на всякий', чтобы не плодить пустых строк
          ''Debug.Print sFileFullName
          List1.List(i) = sFileFullName
          i = i + 1
      End If
  Next SubSubFolder
  Next SubFolder

  Set SubSubFolder = Nothing
  Set SubFolder = Nothing
  Set objFolder = Nothing
  Set fso = Nothing
End Sub

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

Наконец-то получилось то, что было нужно. Вот работающий код:

Option Explicit

Dim oFSO As Object
Public temporB As String
Public i As Integer, j As Integer
Sub Form_load()
i = 0
Const sPath As String = "d:\A\"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Call recurse(sPath)
End Sub

Sub recurse(sPath As String)
Dim oFolder As Object
Dim oSubFolder As Object
Dim oFile As Object
Set oFolder = oFSO.GetFolder(sPath)

For Each oFile In oFolder.Files
Dim Nam As String
If LCase(oFile.Name) Like "*.dcm" Then
Nam = sPath & "\" & oFile.Name
Call Filtr(Nam)
Exit For
End If
Next oFile

For Each oSubFolder In oFolder.SubFolders
Call recurse(oSubFolder.Path)
Next oSubFolder
Call Osnova

End Sub
Sub Filtr(Nam)
Dim x As Long, y As Long, z As Long
Dim tempB As String
x = InStr(Nam, ":\")
y = InStr(x + 2, Nam, "\")
z = InStr(y + 1, Nam, "\")
tempB = Mid(Nam, y + 1, z - y - 1)
If tempB <> temporB Then
temporB = tempB
List1.List(i) = Nam
i = i + 1
End If
End Sub
Sub Osnova()
For j = 0 To List1.ListCount
'Обработка
Next j
End Sub

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

"как скрыть окно Immediate" - у этого окна должен быть крестик в правом верхнем углу.
"как перед вызовом Osnova очистить память от мусора FSO" - Set его как New FileSystemObject, декларировать также, а не как Object.
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37979957
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
fel123VladConn,

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

Что это такое:

Код: vbnet
1.
2.
3.
x = InStr(Nam, ":\")
y = InStr(x + 2, Nam, "\")
z = InStr(y + 1, Nam, "\")



Что ты пытаешься вытащить этими манипуляциями? Части путей, имен, явок, расширений? А почему ты тогда не используешь готовые методы oFSO, зачем он тогда тебе?
...
Рейтинг: 0 / 0
Как перебрать все папки в текущем каталоге командой Dir
    #37979993
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
fel123,

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


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