|
Этот макрос выводит информацию о папке - например, её размер, и количество файлов в ней:
Sub ПодсчётКоличестваФайловВПапке()
' задаём папку
FolderPath = "C:\Documents and Settings\Admin\Рабочий стол\"
' получаем характеристики папки
Set FSO = CreateObject("Scripting.FileSystemObject")
КоличествоФайловВПапкеБезУчётаПодпапок = FSO.GetFolder(FolderPath).Files.Count
КоличествоПодпапок = FSO.GetFolder(FolderPath).SubFolders.Count
РазмерПапкиВБайтах = FSO.GetFolder(FolderPath).Size
' подсчитываем количество файлов с учётом файлов в подпапках
КоличествоФайловВПапкеСУчётомПодпапок = FilesCount(FolderPath)
Debug.Print "В папке найдено " & КоличествоФайловВПапкеБезУчётаПодпапок & " файлов и " & _
КоличествоПодпапок & " подпапок. Всего файлов: " & КоличествоФайловВПапкеСУчётомПодпапок
Debug.Print "Папка занимает на диске " & РазмерПапкиВБайтах & " байтов (" & _
FileOrFolderSize(РазмерПапкиВБайтах) & ")"
End Sub
Результат работы кода (в окне Immediate):
В папке найдено 186 файлов и 31 подпапок. Всего файлов: 4216
Папка занимает на диске 193158100 байтов (184 Мб)
Если же вам надо вывести список файлов на лист Excel - смотрите функцию FilenamesCollection:
http://excelvba.ru/code/FilenamesCollection (Получение списка файлов в папке и подпапках средствами VBA)
Код необходимых функций для подсчёта файлов:
Function FilesCount(ByVal FolderPath As String, Optional ByVal SearchDeep As Long = 999) As Long
' Получает в качестве параметра путь к папке FolderPath,
' и глубину поиска SearchDeep в подпапках (если SearchDeep=1, то подпапки не просматриваются).
' Возвращает количество найденных файлов
' (применяется рекурсивный вызов процедуры GetAllFileNamesUsingFSO)
Set FSO = CreateObject("Scripting.FileSystemObject") ' создаём экземпляр FileSystemObject
FilesCount = GetFilesCountUsingFSO(FolderPath, FSO, SearchDeep) ' подсчёт файлов
Set FSO = Nothing
End Function
Function GetFilesCountUsingFSO(ByVal FolderPath As String, ByRef FSO, ByVal SearchDeep As Long)
' перебирает все файлы и подпапки в папке FolderPath, используя объект FSO
' перебор папок осуществляется в том случае, если SearchDeep > 1
' добавляет пути найденных файлов в коллекцию FileNamesColl
'On Error Resume Next:
Set curfold = FSO.GetFolder(FolderPath)
If Not curfold Is Nothing Then ' если удалось получить доступ к папке
GetFilesCountUsingFSO = curfold.Files.Count
SearchDeep = SearchDeep - 1 ' уменьшаем глубину поиска в подпапках
If SearchDeep Then ' если надо искать глубже
For Each sfol In curfold.SubFolders ' перебираем все подпапки в папке FolderPath
GetFilesCountUsingFSO = GetFilesCountUsingFSO + GetFilesCountUsingFSO(sfol.Path, FSO, SearchDeep)
Next
End If
Set fil = Nothing: Set curfold = Nothing ' очищаем переменные
End If
End Function
Для вывода понятной (отформатированной) информации об объёме папки или файла используется функция FileOrFolderSize:
Function FileOrFolderSize(ByVal s) As String
Size = Fix(Val(s)): ' If s = "" Then FileOrFolderSize = "<нет доступа>"
Select Case Size
Case Is < 1000: FileOrFolderSize = Size & " байт"
Case Is < 10000: FileOrFolderSize = FormatNumber(Size / 1024, 1) & " Кб"
Case Is < 1000000: FileOrFolderSize = FormatNumber(Size \ 1024, 0) & " Кб"
Case Is < 10000000: FileOrFolderSize = FormatNumber(Size / 1024 / 1024, 1) & " Mб"
Case Is < 1000000000: FileOrFolderSize = FormatNumber(Size / 1024 / 1024, 0) & " Мб"
Case Else: FileOrFolderSize = FormatNumber(Size / 1024 / 1024 / 1024, 1) & " Гб"
End Select
End Function
|
