Этот макрос выводит информацию о папке - например, её размер, и количество файлов в ней:

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

• 17042 просмотра