Форум программистов, компьютерный форум, киберфорум
Visual Basic
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.78/18: Рейтинг темы: голосов - 18, средняя оценка - 4.78
0 / 0 / 0
Регистрация: 25.12.2012
Сообщений: 5

Поиск файлов по маске

19.01.2014, 10:18. Показов 3283. Ответов 3
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
Здравствуйте! Изучаю vba. Дали задание сделать поиск файлов по маске.
Посмотрите пожалуйста, может что нибудь надо доработать.
ФОрма

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private serch As New serch
Private Sub CommandButton1_Click()
On Error GoTo Errors1
Dim i As Integer
serch.raspol = textbox1.Text
serch.mask = textbox2.Text
For i = 1 To serch.k
    listbox1.AddItem (serch.item(i))
Next i
GoTo Ends:
Errors1:
    Resume Next
Ends:
End Sub
Класс

Visual Basic
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
Private mraspol As String
Private nmask As String
Private fnp(1000000) As String
Private lnarraynum As Integer
Private lngsheet As Long
Public mstr As String
Public Property Let raspol(ByVal inewraspol As String)
mraspol = inewraspol
End Property
Public Property Let mask(ByVal inewMask As String)
nmask = inewMask
Call search(mraspol, nmask, lngsheet)
End Property
Public Property Get item(lnarraynum As Integer) As String
    item = fnp(lnarraynum)
End Property
Public Property Get k() As Long
    k = lnarraynum
End Property
Public Sub search(mraspol As String, nmask As String, lngsheet As Long)
Dim mstr, strfldrlist() As String
Dim lngarraymax, x As Long
lngarraymax = 0
strFileName = Dir(mraspol & "*.*", vbDirectory + vbNormal)
While strFileName <> ""
    If strFileName <> "." And strFileName <> ".." Then
        If (GetAttr(mraspol & strFileName) And vbDirectory) = vbDirectory Then
            lngarraymax = lngarraymax + 1
            ReDim Preserve strfldrlist(lngarraymax)
            strfldrlist(lngarraymax) = mraspol & strFileName & "\"
        Else
            If strFileName Like nmask Then
               mstr = mraspol & strFileName
               lnarraynum = lnarraynum + 1
               fnp(lnarraynum) = mstr
            End If
        End If
    End If
    strFileName = Dir()
Wend
If lngarraymax <> 0 Then
    For x = 1 To lngarraymax
        Call search(strfldrlist(x), nmask, lngsheet)
    Next
End If
End Sub
Спасибо
0
Лучшие ответы (1)
cpp_developer
Эксперт
20123 / 5690 / 1417
Регистрация: 09.04.2010
Сообщений: 22,546
Блог
19.01.2014, 10:18
Ответы с готовыми решениями:

Получить несколько файлов по маске
Подскажите, пожалуйста, как можно узнать о наличии более чем одного файла в каталоге по маске и получить их имена. DIR() - всегда...

Удаление файлов кроме определенного (по маске)
День добрый всем, кто это читает. На сегодняшний день у меня вопрос такой: есть папка (путь к ней известен), содержащая несколько...

Копирование и удаление нескольких файлов по маске (VB6)
Подскажите плиз &quot;чайнику без ручки&quot; как копировать и удалять несколько файлов по маске *.* Как копировать один файл нашел: FileCopy...

3
Модератор
10057 / 3902 / 884
Регистрация: 22.02.2013
Сообщений: 5,853
Записей в блоге: 79
19.01.2014, 12:38
Лучший ответ Сообщение было отмечено The trick как решение

Решение

Dir и так может искать по маске.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Option Explicit
 
Private Sub Form_Load()
    Dim Z As String, col As Collection
    
    Z = Dir("D:\Temp\AUD*.3gp")
    Set col = New Collection
    
    Do While Len(Z)
        col.Add Z
        Z = Dir()
    Loop
End Sub
, к тому же размерность массива, лучше изменять порциями, а счетчик хранить отдельно. Можно исключить один цикл, если запускать поиск в подпапке сразу в основном цикле.
Так не надо объявлять переменные
Visual Basic
1
2
Dim mstr, strfldrlist() As String
Dim lngarraymax, x As Long
Надо так
Visual Basic
1
2
Dim mstr As String, strfldrlist() As String
Dim lngarraymax As Long, x As Long
или так
Visual Basic
1
2
Dim mstr$, strfldrlist$()
Dim lngarraymax&, x&
2
0 / 0 / 0
Регистрация: 25.12.2012
Сообщений: 5
19.01.2014, 13:02  [ТС]
Цитата Сообщение от The trick Посмотреть сообщение
Dir и так может искать по маске.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Option Explicit
 
Private Sub Form_Load()
    Dim Z As String, col As Collection
    
    Z = Dir("D:\Temp\AUD*.3gp")
    Set col = New Collection
    
    Do While Len(Z)
        col.Add Z
        Z = Dir()
    Loop
End Sub
, к тому же размерность массива, лучше изменять порциями, а счетчик хранить отдельно. Можно исключить один цикл, если запускать поиск в подпапке сразу в основном цикле.
Так не надо объявлять переменные
Visual Basic
1
2
Dim mstr, strfldrlist() As String
Dim lngarraymax, x As Long
Надо так
Visual Basic
1
2
Dim mstr As String, strfldrlist() As String
Dim lngarraymax As Long, x As Long
или так
Visual Basic
1
2
Dim mstr$, strfldrlist$()
Dim lngarraymax&, x&
Хорошо. спасибо.
А поиск в подпапке получается тоже нужно будет организовать рекурсией?
В основном задание еще было как основа понятия рекурсии.
На счёт переменных спасибо, видимо после си забыл..
0
Модератор
10057 / 3902 / 884
Регистрация: 22.02.2013
Сообщений: 5,853
Записей в блоге: 79
19.01.2014, 13:16
Цитата Сообщение от CyberDemon Посмотреть сообщение
А поиск в подпапке получается тоже нужно будет организовать рекурсией?
Да, прямо из главного цикла
1
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
raxper
Эксперт
30234 / 6612 / 1498
Регистрация: 28.12.2010
Сообщений: 21,154
Блог
19.01.2014, 13:16
Помогаю со студенческими работами здесь

Поиск файлов по маске
Имеется имя файла, например : файл.txt Как определить нет ли в папке таких же файлов, только с индексами, наприер: файл (1).txt , файл...

Поиск файлов по маске
Возможно ли сделать так ,чтобы программа сканировала диски и нашла файлы в формате .jpg ?

Поиск файлов по маске
Вот код который ищет директории var s:string; begin for s in TDirectory.GetDirectories('e:\','*z',TSearchOption(1)) do begin ...

Поиск файлов по маске
Пытаюсь сделать поиск файлов в текущей директории, но вылазит 2 ошибки и не могу понять что с ней делать! Вот код:#pragma once ...

Поиск файлов по маске
Нужно найти файлы по маске. Маска и каталог передаётся через параметры. Файлы ищутся также в подкаталогах. import java.io.*; import...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
4
Ответ Создать тему
Новые блоги и статьи
Подстановка значения реквизита справочника в табличную часть документа
Maks 10.04.2026
Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: при выборе сотрудника (справочник Сотрудники) в ТЧ документа. . .
Очистка реквизитов документа при копировании
Maks 09.04.2026
Алгоритм из решения ниже применим как для типовых, так и для нетиповых документов на самых различных конфигурациях. Задача: при копировании документа очищать определенные реквизиты и табличную. . .
модель ЗдравоСохранения 8. Подготовка к разному выполнению заданий
anaschu 08.04.2026
https:/ / github. com/ shumilovas/ med2. git main ветка * содержимое блока дэлэй из старой модели теперь внутри зайца новой модели 8ATzM_2aurI
Блокировка документа от изменений, если он открыт у другого пользователя
Maks 08.04.2026
Алгоритм из решения ниже реализован на примере нетипового документа, разработанного в конфигурации КА2. Задача: запретить редактирование документа, если он открыт у другого пользователя. / / . . .
Система безопасности+живучести для сервера-слоя интернета (сети). Двойная привязка.
Hrethgir 08.04.2026
Далее были размышления о системе безопасности. Сообщения с наклонным текстом - мои. А как нам будет можно проверить, что ссылка наша, а не подделана хулиганами, которая выбросит на другую ветку и. . .
Модель ЗдрввоСохранения 7: больше работников, больше ресурсов.
anaschu 08.04.2026
работников и заданий может быть сколько угодно, но настроено всё так, что используется пока что только 20% kYBz3eJf3jQ
Дальние перспективы сервера - слоя сети с космологическим дизайном интефейса карты и логики.
Hrethgir 07.04.2026
Дальнейшее ближайшее планирование вывело к размышлениям над дальними перспективами. И вот тут может быть даже будут нужны оценки специалистов, так как в дальних перспективах всё может очень сильно. . .
Горе от ума
kumehtar 07.04.2026
Эта мне ментальная установка, что вот прямо сейчас, мол, мне для полного счастья не хватает (нужное вписать), и когда я этого достигну - тогда и полный кайф. Одна из самых сильных ловушек на пути. . . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru