Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Перебор всех файлов и папок в указанном файле - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перебор всех файлов и папок в указанном файле (Макросы/Sub)
Перебор всех файлов и папок в указанном файле
Aero16 Дата: Пятница, 09.03.2018, 15:34 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Доброго дня, есть такой макрос, он показывает количество объектов, файлов и папок, в указанной папке, не получается доработать чтоб он показывал количество файлов не только в указанной папке, но и в нижележащих папках. Может кто подскажет как это сделать. Спасибо

[vba]
Код

Sub dirf()
   Dim iPath$, iCountFolders&, iCountFiles&
   Dim iFolder As Object, iFolderItem As Object

   iPath = "C:\Temp" '

   Set iFolder = _
   CreateObject("Shell.Application").Namespace(CVar(iPath))
   If Not iFolder Is Nothing Then
      For Each iFolderItem In iFolder.Items
          If Not iFolderItem.IsFolder Then
             iCountFiles = iCountFiles + 1
          Else
             iCountFolders = iCountFolders + 1
          End If
        
      Next
      MsgBox "Всего объектов в папке = " & iFolder.Items.Count
      MsgBox "Папок в папке = " & iCountFolders
      MsgBox "Файлов в папке = " & iCountFiles
   Else
      MsgBox "такой папки нет", vbCritical, iPath
   End If
End Sub
[/vba]
 
Ответить
СообщениеДоброго дня, есть такой макрос, он показывает количество объектов, файлов и папок, в указанной папке, не получается доработать чтоб он показывал количество файлов не только в указанной папке, но и в нижележащих папках. Может кто подскажет как это сделать. Спасибо

[vba]
Код

Sub dirf()
   Dim iPath$, iCountFolders&, iCountFiles&
   Dim iFolder As Object, iFolderItem As Object

   iPath = "C:\Temp" '

   Set iFolder = _
   CreateObject("Shell.Application").Namespace(CVar(iPath))
   If Not iFolder Is Nothing Then
      For Each iFolderItem In iFolder.Items
          If Not iFolderItem.IsFolder Then
             iCountFiles = iCountFiles + 1
          Else
             iCountFolders = iCountFolders + 1
          End If
        
      Next
      MsgBox "Всего объектов в папке = " & iFolder.Items.Count
      MsgBox "Папок в папке = " & iCountFolders
      MsgBox "Файлов в папке = " & iCountFiles
   Else
      MsgBox "такой папки нет", vbCritical, iPath
   End If
End Sub
[/vba]

Автор - Aero16
Дата добавления - 09.03.2018 в 15:34
Апострофф Дата: Пятница, 09.03.2018, 18:28 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 444
Репутация: 122 ±
Замечаний: 0% ±

Excel 1997
Aero16, пробуйте -
[vba]
Код
Dim f&, d&, c&

Sub main()
G CreateObject("Scripting.FileSystemObject").getfolder("C:\Temp")
Stop 'угадайте, что в f, d, c
End Sub

Sub G(fol)
For Each fi In fol.Files
    c = c + 1
    f = f + 1
Next
For Each fo In fol.subfolders
  c = c + 1
  d = d + 1
  G fo
Next
End Sub
[/vba]
 
Ответить
СообщениеAero16, пробуйте -
[vba]
Код
Dim f&, d&, c&

Sub main()
G CreateObject("Scripting.FileSystemObject").getfolder("C:\Temp")
Stop 'угадайте, что в f, d, c
End Sub

Sub G(fol)
For Each fi In fol.Files
    c = c + 1
    f = f + 1
Next
For Each fo In fol.subfolders
  c = c + 1
  d = d + 1
  G fo
Next
End Sub
[/vba]

Автор - Апострофф
Дата добавления - 09.03.2018 в 18:28
Roman777 Дата: Пятница, 09.03.2018, 19:01 | Сообщение № 3
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Aero16, Ваш же макрос, но с небольшой вынесенной рекурсией:
[vba]
Код
Sub dirf()
Dim iPath$, iCountFolders&, iCountFiles&
Dim iFolder As Object, iFolderItem As Object

'iPath = "C:\Temp" '

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select the folder in which the files to be processed"
    .ButtonName = "Select": .AllowMultiSelect = False
    If .Show Then iPath = .SelectedItems(1) Else Exit Sub
End With

Set iFolder = _
CreateObject("Shell.Application").Namespace(CVar(iPath))
If Not (iFolder Is Nothing) Then
    Call NextFold(iFolder, iCountFiles, iCountFolders)

    MsgBox "Всего объектов в папке = " & CStr(iCountFolders + iCountFiles)
    MsgBox "Папок в папке = " & iCountFolders
    MsgBox "Файлов в папке = " & iCountFiles
Else
    MsgBox "такой папки нет", vbCritical, iPath
End If
End Sub
Function NextFold(p As Variant, ByRef flCount As Long, ByRef fldCount As Long)
    If Not (p Is Nothing) Then
        For Each iFolderItem In p.Items
            If Not iFolderItem.IsFolder Then
                flCount = flCount + 1
            Else
                fldCount = fldCount + 1
                Call NextFold(CreateObject("Shell.Application").Namespace(CVar(iFolderItem.Path)), flCount, fldCount)
            End If
        Next iFolderItem
    End If
End Function
[/vba]
Но вообще, такой код, который у Вас изначально дан (ну и моя модификация), Zip файлы тоже считает папками...

отредактировал. была лишняя строчка перед "Call NextFold(CreateObject("Shell.Application").Namespace(CVar(iFolderItem.Path)), flCount, fldCount)" в функции NextFold


Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Пятница, 09.03.2018, 20:17
 
Ответить
СообщениеAero16, Ваш же макрос, но с небольшой вынесенной рекурсией:
[vba]
Код
Sub dirf()
Dim iPath$, iCountFolders&, iCountFiles&
Dim iFolder As Object, iFolderItem As Object

'iPath = "C:\Temp" '

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select the folder in which the files to be processed"
    .ButtonName = "Select": .AllowMultiSelect = False
    If .Show Then iPath = .SelectedItems(1) Else Exit Sub
End With

Set iFolder = _
CreateObject("Shell.Application").Namespace(CVar(iPath))
If Not (iFolder Is Nothing) Then
    Call NextFold(iFolder, iCountFiles, iCountFolders)

    MsgBox "Всего объектов в папке = " & CStr(iCountFolders + iCountFiles)
    MsgBox "Папок в папке = " & iCountFolders
    MsgBox "Файлов в папке = " & iCountFiles
Else
    MsgBox "такой папки нет", vbCritical, iPath
End If
End Sub
Function NextFold(p As Variant, ByRef flCount As Long, ByRef fldCount As Long)
    If Not (p Is Nothing) Then
        For Each iFolderItem In p.Items
            If Not iFolderItem.IsFolder Then
                flCount = flCount + 1
            Else
                fldCount = fldCount + 1
                Call NextFold(CreateObject("Shell.Application").Namespace(CVar(iFolderItem.Path)), flCount, fldCount)
            End If
        Next iFolderItem
    End If
End Function
[/vba]
Но вообще, такой код, который у Вас изначально дан (ну и моя модификация), Zip файлы тоже считает папками...

отредактировал. была лишняя строчка перед "Call NextFold(CreateObject("Shell.Application").Namespace(CVar(iFolderItem.Path)), flCount, fldCount)" в функции NextFold

Автор - Roman777
Дата добавления - 09.03.2018 в 19:01
Aero16 Дата: Пятница, 09.03.2018, 20:05 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Ваш же макрос, но с небольшой вынесенной рекурсией:

Большое спасибо, мне это и нужно было, теперь еще немного допилю и как раз что надо specool
 
Ответить
Сообщение
Ваш же макрос, но с небольшой вынесенной рекурсией:

Большое спасибо, мне это и нужно было, теперь еще немного допилю и как раз что надо specool

Автор - Aero16
Дата добавления - 09.03.2018 в 20:05
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перебор всех файлов и папок в указанном файле (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!