Здравствуйте, почитал инструкцию https://www.planetaexcel.ru/techniques/3/45/ но так и не смог применить для своего случая эти знания. Может быть подскажете элегантное решение. Дана таблица в экселе, где в одном столбце приведено точное название папки, не путь, а название. Соответственно во второй столбец необходимо вставить значение - это размер папки. Например в гигабайтах. Пробовал при помощи Power Query создать список фалов и потом консолидировать по имени папки. Но, видимо, слишком много значений и результата не выходит. Да и вообще, хочется как-то проще - без промежуточных табличек. С vba знаком только на уровне ctrl+c +v ))) Прошу вашей помощи или каких-то идей =) Спасибо.
cmepx написал: Дана таблица в экселе, где в одном столбце приведено точное название папки, не путь, а название. Соответственно во второй столбец необходимо вставить значение - это размер папки.
на моем компе есть папка 1 и она не одна c таким именем, Вы можете сказать её размер? Также будет в растерянности и любой скрипт VBA.
Зачем же так утрировать. Но согласен, что моя оплошность - не уточнил, где папки. Папки находятся на отдельном жёстком диске в корне и имеют уникальное название. Надо узнать размер каждой папки первого (верхнего) уровня на диске. И да, на других дисках, нет копий этих папок или папок с таким же названием. За уникальность ручаюсь ))
А иначе и не будет, у папки нет свойства размер и для его определения сканируются все вложенные папки и файлы.
Не всегда
Код
Set FSO = CreateObject("Scripting.FileSystemObject")
dirSize = FSO.GetFolder(dirPath).Size
Возможно поможет
Код
Sub test()
Const dirPath = "c:\"
On Error Resume Next
Set FSO = CreateObject("Scripting.FileSystemObject")
i = 1
With Sheet1
.UsedRange.ClearContents
.Cells(1, 1) = "Folder Name"
.Cells(1, 2) = "Folder size MB"
For Each Folder In FSO.GetFolder(dirPath).subfolders
i = i + 1
.Cells(i, 1) = Folder.Name
.Cells(i, 2) = Folder.Size / 1024 / 1024
If Err <> 0 Then
.Cells(i, 2) = "NoAccess"
Err.Clear
End If
Next
End With
End Sub
Изменено: БМВ - 21.01.2020 11:08:49(Убрал Set foder = FSO.GetFolder(Folder), а то и не мешает и лишнее :-))
artyrH, если хотите чтобы было быстро, то рекомендую использовать Folder.Contents вместо Folder.Files. Эта функция не сканирует все содержимое вложенных папок в отличие от, а показывает содержимое только указанной папки. при этом содержимое вложенных папок показано в виде таблиц, т.е. если нужно, то можно добраться до папки любого уровня вложенности. В таком случае все работает значительно быстрее. БМВ, там все хуже, функция использованная Артемом сканирует вообще весь диск, а нужно сначала через Folder.Contents найти нужные юзеру папки, а потом уже через Folder.Files сканировать только их и считать, только их содержимое.
Sub Папка()
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject").GetFolder("C:\Users\Александр\Downloads")
MsgBox Round(FSO.Size / 1048576, 1) & " МБайт"
End Sub
Мастерство программиста не в том, чтобы писать программы, работающие без ошибок. А в том, чтобы писать программы, работающие при любом количестве ошибок.
Меня отвлекли поэтому убежал потом прибежал дописал, а вы смотрю уже исправили.
Мастерство программиста не в том, чтобы писать программы, работающие без ошибок. А в том, чтобы писать программы, работающие при любом количестве ошибок.
Спасибо всем за столь бурное обсуждение и оперативный ответ. Сделал для примера небольшой списочек и скопировал скрипт. Поменял в скрипте букву диска. Думал, что при запуске скрипта появятся данные в выделенной ячейке, но ничего не произошло. Скрипт отработал, но ничего не выдал. Подскажите, как этот скрипт правильно применить. Спасибо.
Только список не нужен, он затрется, так как скрипт просканирует все что есть. А для списка этот, проверку на наличие поленился делать
Код
Sub test1()
Const dirPath = "G:\"
On Error Resume Next
Set FSO = CreateObject("Scripting.FileSystemObject")
With ActiveSheet
For Each mCELL In .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown))
mCELL.Offset(, 1) = FSO.GetFolder(dirPath & mCELL).Size / 1024 / 1024
If Err <> 0 Then
mCELL.Offset(, 1) = "NoAccess"
Err.Clear
End If
Next
End With
End Sub