Гость
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / ProgressIndicator при рекурсии / 5 сообщений из 5, страница 1 из 1
17.04.2013, 10:41
    #38228641
Saules
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ProgressIndicator при рекурсии
Доброго всем дня!
помогите, пожалуйста, разобратся с использованием прогресс индикатора при рекурсии.сейчас получается что на каждую папку счетчик обнуляется и срабатывает заново.да и сообщения о неправильных названиях выводятся на каждую папку, а не в конце всей работы

Код: 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.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
Public Sub ListAllFilez(Optional sPath As String, Optional IncludeSubfolders)

    Dim objFSO As Object
    Dim objFolder As Object
    Dim mySubFolder As Object
    Dim objFile As Object
    Dim ws As Worksheet
    Dim MaxRow, numFolders, IntCount  As Long
    Dim i As Integer
    Dim pi As New ProgressIndicator
    Dim gExt, wExt
    Dim st, sFileName, str As String
    Dim testName, testDate As Boolean
    Dim dt As Date
    Dim rx As Object
    Dim nameCount, dateCount, fileCount, count As Long

    nameCount = 0
    dateCount = 0
    Application.ScreenUpdating = False

     If objFSO Is Nothing Then
        Set objFSO = CreateObject("Scripting.FileSystemObject")
    End If

    If sPath = "" Then
    End
    End If

    Set ws = Sheet1
    MaxRow = 0
     'Get the folder object associated with the directory
    Set objFolder = objFSO.GetFolder(sPath)


    fileCount = Count_Files(sPath)''подсчитываем сколько всего файлов в подпапках
    count = objFolder.Files.count '' сколько файлов в выбранной папке

    If count <> 0 Then
      MaxRow = count + fileCount
    Else
      MaxRow = fileCount
    End If

       frmBrowse.Hide
       pi.Show "чтение файлов"
       pi.StartNewAction 1, 100, , , , MaxRow 


    For Each objFile In objFolder.Files

        If  UCase$(Right$(objFile.Name, 4)) = ".JPG" Or UCase$(Right$(objFile.Name, 4)) = ".JPEG" Then
        str = objFile.Name

        pi.SubAction , "Считан $index из $count", "$time"
        DoEvents

        ws.Cells(ws.UsedRange.Rows.count + 1, 1).Value = objFile.Name
        ws.Cells(ws.UsedRange.Rows.count, 2).Value = objFile.path
        ws.Range(Cells(ws.UsedRange.Rows.count - 1, 4), Cells(ws.UsedRange.Rows.count, ws.UsedRange.Columns.count)).FillDown

        testName = CheckName(str)

      If testName = True Then
          ''если название правльное, то проверяем дату
           If testDate = False Or dt > Date Then
                 dateCount = dateCount + 1
                 ws.Cells(ws.UsedRange.Rows.count, 1).Interior.ColorIndex = 43
           End If
      Else
          nameCount = nameCount + 1
          ws.Cells(ws.UsedRange.Rows.count, 1).Interior.ColorIndex = 3
      End If

        End If
    Next

If IncludeSubfolders Then

For Each mySubFolder In objFolder.subfolders
Call ListAllFilez(mySubFolder.path, True)
Next
End If


     'Clean up!
    pi.Hide
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing
   Application.ScreenUpdating = True

    If nameCount = 0 And dateCount > 0 Then
     MsgBox "Файлы считаны. Есть " & dateCount & " файлов с неправильным форматом даты!"
     ElseIf nameCount > 0 And dateCount = 0 Then
     MsgBox "Файлы считаны. Есть " & nameCount & " файлов с неправильным названием!"
     ElseIf nameCount > 0 And dateCount > 0 Then
     MsgBox "Файлы считаны. Есть " & nameCount & " файлов с неправильным названием и " & dateCount & " файлов с неправильным форматом даты"
     Else
     MsgBox "Файлы успешно считаны!"

     End If



End Sub
...
Рейтинг: 0 / 0
17.04.2013, 11:54
    #38228839
Akina
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ProgressIndicator при рекурсии
Поскольку теоретически определить количество входов в рекурсивную процедуру невозможно - я бы показывал прогресс-бар для текущего каталога и счётчик количества обработанных каталогов.
...
Рейтинг: 0 / 0
17.04.2013, 14:08
    #38229186
Antonariy
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ProgressIndicator при рекурсии
Разве что предварительно быстренько рекурсивно их пересчитать. Винда, кстати, так и делает.
...
Рейтинг: 0 / 0
17.04.2013, 15:41
    #38229428
Saules
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ProgressIndicator при рекурсии
AntonariyРазве что предварительно быстренько рекурсивно их пересчитать. Винда, кстати, так и делает.
а как это прилепить к макросу excell?
...
Рейтинг: 0 / 0
17.04.2013, 18:41
    #38229824
Antonariy
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ProgressIndicator при рекурсии
А чем проблема? Скопировать названия файлов можете, а сосчитать нет?
...
Рейтинг: 0 / 0
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / ProgressIndicator при рекурсии / 5 сообщений из 5, страница 1 из 1
Целевая тема:
Создать новую тему:
Автор:
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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