Доброго дня, есть такой макрос, он показывает количество объектов, файлов и папок, в указанной папке, не получается доработать чтоб он показывал количество файлов не только в указанной папке, но и в нижележащих папках. Может кто подскажет как это сделать. Спасибо
[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
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
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)" в функции NextFoldRoman777
Много чего не знаю!!!!
Сообщение отредактировал Roman777 - Пятница, 09.03.2018, 20:17