Microsoft Excel | Заметки | Перебор изображений в выбранной папке и подсчёт их размеров

Microsoft Excel:

Таблицы и VBA. Справочник.
Вопросы и Ответы. Советы. Примеры.

Меню

Заметки | Перебор изображений в выбранной папке и подсчёт их размеров

Если возникла задача перебрать все изображения в указанной папке, то можно воспользоваться предыдущей заметкой и перебрать все файлы в папке и сравнивать расширение файла с заранее составленным списком расширений файлов-изображений. Можно также сразу явно указать в макросе все интересующие нас расширения файлов и перебирать только перечисленные. А если в папке наличествует только один тип файлов, то и перечислять ничего не нужно, т.к. достаточно будет указать необходимый.

Но если типов много, причём могут встречаться "экзотические" и редко используемые типы, например, .emf, .wmf, .tiff и т.д., то можно, по незнанию, что-то пропустить и остаться без отчёта.

Поэтому, имеет смысл ориентироваться не на разрешение файла, а на его свойства. И если Вы являетесь обладателем руссифицированной версии Windows, то можете выполнить нижеопубликованный макрос и получить результат в байтах.

Private Sub SizeAllImageFiles() 'Только для руссиф. версии Windows
    Dim iPath, iSize, iFolder As Object, iFolderItem As Object
    iPath = "C:\Users\Public\Pictures": iSize = 0
   
    Set iFolder = CreateObject("Shell.Application").Namespace(iPath)
    If Not iFolder Is Nothing Then
       For Each iFolderItem In iFolder.Items
           If iFolder.GetDetailsOf(iFolderItem, 11) = "Изображение" Then
              iSize = iSize + iFolderItem.Size
              'iSize = iSize + FileLen(iFolderItem.Path)
           End If
       Next
       MsgBox iSize & " байт", , ""
    End If
End Sub

А если возникнет необходимость в создании списка таких файлов-изображений, то :

Private Sub Create_ListSizeAllImages() 'Только для руссиф. версии Windows
    Dim iPath, iSize, iRow&: iSize = 0: iRow = 2
    Dim iFolder As Object, iFolderItem As Object    
    iPath = "C:\Users\Public\Pictures"
   
    Set iFolder = CreateObject("Shell.Application").Namespace(iPath)
    If Not iFolder Is Nothing Then
       Workbooks.Add xlWBATWorksheet
       Range("A1:B1").Font.Bold = True
       Range("A1:B1") = Array("Имя файла", "Размер (байт)")
       For Each iFolderItem In iFolder.Items
           If iFolder.GetDetailsOf(iFolderItem, 11) = "Изображение" Then
              Cells(iRow, 1) = iFolderItem.Name
              Cells(iRow, 2) = iFolderItem.Size
              iSize = iSize + iFolderItem.Size
              'iSize = iSize + FileLen(iFile.Path)
              iRow = iRow + 1
           End If
       Next
       Columns("A:B").AutoFit 'Range("A:B").Columns.AutoFit
       Cells(1, 3) = iSize 'Range("C1").Formula = "=SUM(B:B)"
    End If
End Sub

или

Private Sub Create_ListSizeAllImages2() 'Только для руссиф. версии Windows
    Dim iPath$, iRow&, iSize: iSize = 0
    Dim iFolder As Object, iFolderItem As Object    
    iPath = "C:\Users\Public\Pictures"
   
    Set iFolder = CreateObject("Shell.Application").Namespace((iPath))
    If Not iFolder Is Nothing Then
       ReDim iArr(1 To iFolder.Items.Count, 1 To 2)
       For Each iFolderItem In iFolder.Items
           If iFolder.GetDetailsOf(iFolderItem, 11) = "Изображение" Then
              iRow = iRow + 1
              iArr(iRow, 1) = iFolderItem.Name
              iArr(iRow, 2) = iFolderItem.Size
              iSize = iSize + iFolderItem.Size
              'iSize = iSize + FileLen(iFile.Path)
           End If
       Next
    End If
    If iRow > 0 Then
       Workbooks.Add xlWBATWorksheet
       Range("A1:B1").Font.Bold = True
       Range("A1:B1") = Array("Имя файла", "Размер (байт)")
       Range("A2:B2").Resize(iRow) = iArr
       Range("A:B").Columns.AutoFit 'Columns("A:B").AutoFit
       Range("C1").Formula = "=SUM(B:B)" 'Range("C1") = iSize
    End If
End Sub

И, наконец, если Вы решите узнать какие именно типы файлов занимают место в указанной папке, то для этого можно выполнить другой макрос.

Private Sub Create_ListSizeAllTypes3()
    Dim iArchive As Object, iRow&, iType$, iPath
    Dim iFolder As Object, iFolderItem As Object
    
    iPath = Application.Path '"C:\Users\Администратор\Downloads"
    If Dir(iPath, vbDirectory) = "" Then Exit Sub
    
    Set iFolder = CreateObject("Shell.Application").Namespace(iPath)
    Set iArchive = CreateObject("Scripting.Dictionary")

    For Each iFolderItem In iFolder.Items
        If Not iFolderItem.IsFolder Then
           iType = iFolderItem.Type
           iArchive(iType) = iArchive(iType) + iFolderItem.Size
        End If
    Next
    
    iRow = iArchive.Count: If iRow = 0 Then Exit Sub
    
    Workbooks.Add xlWBATWorksheet
    Range("A1:B1").Font.Bold = True
    Range("A1:B1") = Array("Тип файла", "Общий размер (байт)")
    Range("A2").Resize(iRow) = Application.Transpose(iArchive.Keys)
    Range("B2").Resize(iRow) = Application.Transpose(iArchive.Items)
    Range("A:B").Sort Cells(1, 2), xlDescending, Header:=xlYes
    Range("A:B").Columns.AutoFit 'Columns("A:B").AutoFit
End Sub

Вопросы, связанные с этой темой

FAQ592 : Как используя об'ект Shell получить доступ к некоторым свойствам закрытого офисного документа ?

FAQ421 : Как отобразить диалоговое окно, позволяющее выбрать нужную папку (Microsoft Excel XP и старше) ?

FAQ422 : Как используя об'ект Shell отобразить диалоговое окно, позволяющее выбрать нужную папку ?

Автор : Климов Павел Юрьевич

WebDesign & Error's Klimoff

Microsoft Excel:

Таблицы и VBA. Справочник. Вопросы и Ответы. Советы. Примеры.

Таблицы и VBA. Справочник.
Вопросы и Ответы. Советы. Примеры.