powered by simpleCommunicator - 2.0.53     © 2025 Programmizd 02
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Как перебрать все папки в текущем каталоге командой Dir
25 сообщений из 67, страница 2 из 3
Период между сообщениями больше года.
Как перебрать все папки в текущем каталоге командой 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) & "\") 'Âîò çäåñü íå ìåíÿåòñÿ 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
25 сообщений из 67, страница 2 из 3
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Как перебрать все папки в текущем каталоге командой Dir
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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