Модераторы: Akina
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Показывает в папке все txt-файлы, Что за ошибка не могу понять 
:(
    Опции темы
Voldemar2004
Дата 1.6.2005, 15:10 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1650
Регистрация: 25.12.2004

Репутация: 7
Всего: 23
Кусок кода показывает в папке все txt-файлы и их количество.
Компилятор видит ошибку, а я нет.

Код

Public G As Long
Public fn As String

Option Explicit

Private Sub Command2_Click()
Dim c As String
Dim i As Long

fn = Dir("e:\folder\*.txt")

Do
fn = fn + vbCrLf + Dir ' и здесь ошибка
Text1.Text = fn
Loop While fn = fn

        For i = 1 To Len(Text1.Text)
        c = Mid(Text1.Text, i, 1)
        If c = vbCr Then G = G + 1
        Next i
       
MsgBox "Количество файлов = " & G

End Sub



--------------------
i_i 
(';') 
(V)

user posted image
PM MAIL   Вверх
boevik
Дата 1.6.2005, 15:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1452
Регистрация: 31.5.2004
Где: Израиль

Репутация: 12
Всего: 35
Voldemar2004, у тебя плохо условие написано, никогда не остановится loop

Вызов Dir после возврата пустого значения (т.е. когда нет больше файлов) , выдает ошибку.


--------------------
Никогда не говори никогда
PM MAIL WWW   Вверх
USSR_hacker
Дата 1.6.2005, 16:15 (ссылка) | (голосов: 0) Загрузка ... Загрузка ... Быстрая цитата Цитата


Unregistered
Код

fn = fn + vbCrLf + Dir ' и здесь ошибка

Чтоб менше глюков ныло, исползуй это вместо + &:
Код

fn = fn & vbCrLf & Dir ' и здесь нет ошибки
  Вверх
efedron
Дата 1.6.2005, 16:29 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 135
Регистрация: 16.3.2005

Репутация: 4
Всего: 4
Voldemar2004
все правильно, и должна быть ошибка, а как ты еще хотел, чтоб функция dir тебе сказала, что файлов таких в папке больше нет? smile
--------------------
Прежде чем совершить акт разрезания определенной материи целесообразно удостовериться в правильности всех произведенных измерений.
PM MAIL   Вверх
Guest
Дата 3.6.2005, 10:49 (ссылка) | (голосов: 0) Загрузка ... Загрузка ... Быстрая цитата Цитата


Unregistered
Юзай захайденный FileListBox. Это сведет к нулю ошибки при работе со списком файлов.
  Вверх
Voldemar2004
Дата 4.6.2005, 10:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1650
Регистрация: 25.12.2004

Репутация: 7
Всего: 23
Цитата

Юзай захайденный FileListBox

вообще-то я хотел написать универсальную ф-цию, где в проге вообще может не быть FileListBox'a. smile


--------------------
i_i 
(';') 
(V)

user posted image
PM MAIL   Вверх
efedron
Дата 4.6.2005, 10:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 135
Регистрация: 16.3.2005

Репутация: 4
Всего: 4
Voldemar2004
добавь on local error resume next и все будет воркать smile
--------------------
Прежде чем совершить акт разрезания определенной материи целесообразно удостовериться в правильности всех произведенных измерений.
PM MAIL   Вверх
cardinal
Дата 4.6.2005, 13:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Инженер
****


Профиль
Группа: Экс. модератор
Сообщений: 6003
Регистрация: 26.3.2002
Где: Германия

Репутация: 19
Всего: 99
Код

Option Explicit

Private Sub Command1_Click()

Dim fn As String
Dim i As Long

fn = Dir("e:\*.txt")
Do While fn <> ""
    List1.AddItem fn
    i = i + 1
    fn = Dir
Loop

Text1.Text = i

End Sub

Поставь на форму кнопку, ListBox и TextBox...


--------------------
Немецкая оппозиция потребовала упростить натурализацию иммигрантов
В моем блоге: Разные истории из жизни в Германии

"Познание бесконечности требует бесконечного времени, а потому работай не работай - все едино".  А. и Б. Стругацкие
PM   Вверх
Voldemar2004
Дата 4.6.2005, 16:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1650
Регистрация: 25.12.2004

Репутация: 7
Всего: 23
Цитата

добавь on local error resume next и все будет воркать


Это первое, что я сделал, чтобы проверить, работает оно или нет. Но хотел цивилизованным путем.


--------------------
i_i 
(';') 
(V)

user posted image
PM MAIL   Вверх
Voldemar2004
Дата 4.6.2005, 18:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1650
Регистрация: 25.12.2004

Репутация: 7
Всего: 23
cardinal, большое спасибо.
Код

Public i As Long
Option Explicit

Private Sub Command1_Click()
i = 0
List1.Clear
MsgBox FileList(Combo2.Text, Combo1.Text) & _
"Количество файлов в папке " & Chr(34) & Combo2.Text _
& Chr(34) & " с расширением" & Combo1.Text & " = " & i
End Sub

Private Function FileList(Path As String, Ext As String) As String
Dim fn As String
fn = Dir(Path & Ext)
Do While fn <> ""
    List1.AddItem fn
    i = i + 1
    fn = Dir
Loop
End Function


В Combo2 имя диска (ну можно заменить на DriveListBox)
В Combo1 расширение (*.txt *.html *.htm и т.д.)

Поставил на форму кнопку, 2 ComboBox, ListBox

Только заметил одну вещь: если выбрать расширение htm, то будут выделены и файлы html (а нам этого не надо).
Как по простому это сделать.


--------------------
i_i 
(';') 
(V)

user posted image
PM MAIL   Вверх
cardinal
Дата 4.6.2005, 20:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Инженер
****


Профиль
Группа: Экс. модератор
Сообщений: 6003
Регистрация: 26.3.2002
Где: Германия

Репутация: 19
Всего: 99
Видимо так:
Код

Option Explicit

Private Sub Command1_Click()

Dim fn As String
Dim ext As String
Dim i As Long

ext = "*.htm"
fn = Dir("e:\" & ext)
Do While fn <> ""
    If Right(fn, 3) = ext Then
        List1.AddItem fn
        i = i + 1
    End If
    fn = Dir
Loop

Text1.Text = i

End Sub



--------------------
Немецкая оппозиция потребовала упростить натурализацию иммигрантов
В моем блоге: Разные истории из жизни в Германии

"Познание бесконечности требует бесконечного времени, а потому работай не работай - все едино".  А. и Б. Стругацкие
PM   Вверх
Voldemar2004
Дата 5.6.2005, 15:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1650
Регистрация: 25.12.2004

Репутация: 7
Всего: 23
cardinal, я проверил твой код, так он не работает... smile

Код

Public i As Long
Option Explicit

Private Sub Command1_Click()    
i = 0    
List1.Clear    
MsgBox FileList(Combo2.Text, Combo1.Text) & _    
"Количество файлов в папке " & Chr(34) & Combo2.Text _    
& Chr(34) & " с расширением" & Combo1.Text & " = " & i    
End Sub

Private Function FileList(Path As String, Ext As String) As String

Dim fn As String
fn = Dir(Path & Ext)
Do While fn <> ""
    If "*" & Right(fn, 4) = Right(Ext, 5) Then
        List1.AddItem fn
        i = i + 1
    Else:

        If Right(fn, 4) = Right(Ext, 4) Then
        List1.AddItem fn
        i = i + 1
        End If
        
    End If
    fn = Dir
Loop
End Function


Вот здесь что-то не то:
Цитата

If Right(fn, 3) = ext Then


Включи точки останова, посмотри, что будет.


--------------------
i_i 
(';') 
(V)

user posted image
PM MAIL   Вверх
cardinal
Дата 5.6.2005, 16:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Инженер
****


Профиль
Группа: Экс. модератор
Сообщений: 6003
Регистрация: 26.3.2002
Где: Германия

Репутация: 19
Всего: 99
Да, извини. Я просто вставил код уже в сообщение, а потом думаю, что кое-что можно изменить. Изменил и получилось, то что ты уже сказал. smile Вот что я имел в виду:
Код

Option Explicit

Private Sub Command1_Click()

Dim fn As String
Dim ext As String
Dim i As Long

ext = "htm"
fn = Dir("e:\*." & ext)
Do While fn <> ""
    If Right(fn, 3) = ext Then
        List1.AddItem fn
        i = i + 1
    End If
    fn = Dir
Loop

Text1.Text = i

End Sub

Я же в ext хочу только расширение, а не звездочки всякие...


--------------------
Немецкая оппозиция потребовала упростить натурализацию иммигрантов
В моем блоге: Разные истории из жизни в Германии

"Познание бесконечности требует бесконечного времени, а потому работай не работай - все едино".  А. и Б. Стругацкие
PM   Вверх
boevik
Дата 5.6.2005, 16:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1452
Регистрация: 31.5.2004
Где: Израиль

Репутация: 12
Всего: 35
Если extension не равен 3 буквам, то в этом месте баг
Код

If Right(fn, 3) = ext Then



--------------------
Никогда не говори никогда
PM MAIL WWW   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "VB6"
Akina

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по VB обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • Используйте теги [code=vb][/code] для подсветки кода. Используйтe чекбокс "транслит" (возле кнопок кодов) если у Вас нет русских шрифтов.

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Akina.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | VB6 | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0658 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.