Count images larger than a give size in a folder with vba

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,632
Office Version
2016
Platform
Windows
Hello again,

I have been searching the net for a while now to find a solution to my problem.

I have come close in most cases but not right to the point.

I want to go to a folder called "MyImages" in the location on my workbook. That's. ..... ThisWorkbook.Path & "\MyImages".

Then I count all images that are above 50kb and show results in a MsgBox alert.

Basically the images will be jpeg files but I will be glad if we can track all other image formats as well.

Thanks
 

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,632
Office Version
2016
Platform
Windows
I have seen the code, tried setting

FolderPath = ThisWorkbook.Path & "\MyImages"

Then when I run it, it does not.

It looks like the macro is not available.

I can seem to figure out why
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
7,493
Office Version
2016
Platform
Windows
Actually, after taken a propper look at that routine, I found that it is not correct because it is recursive and the variables are lost .

Here is a better approach that uses a recursive FUNCTION instead of SUB and also should return all images file types :

In a Standard Module:
Code:
Option Explicit

Type FOUND_FILES
    FilesList() As String
    FilesCount As Long
End Type

Function GetImageFiles(FolderPath As String, MinFileSize As Double, Optional ByVal NewSearch As Boolean = True) As FOUND_FILES

    'define variables
    Dim fso As Object
    Dim objFolder As Object
    Dim objFolders As Object
    Dim objF As Object
    Dim objFile As Object
    Dim objFiles As Object
    Dim strFileName As String
    
    Static lFileCount As Long
    Static arImages() As String

    'set file system object
    Set fso = CreateObject("Scripting.FileSystemObject")

    'set folder object
    Set objFolder = fso.GetFolder(FolderPath)

    'set files
    Set objFiles = objFolder.Files
    Set objFolders = objFolder.subfolders

    'list all images in folder
    For Each objFile In objFiles
        If InStr(1, ".jpeg.jpg.bmp.png.tiff.raw", Split(objFile.Name, ".")(UBound(Split(objFile.Name, "."))), vbTextCompare) Then
            If objFile.Size >= MinFileSize Then
                strFileName = objFile.Name
                ReDim Preserve arImages(lFileCount)
                arImages(lFileCount) = strFileName
                lFileCount = lFileCount + 1
            End If
        End If
    Next

    'go through all subflders
    For Each objF In objFolders
        Call GetImageFiles(objF.Path, MinFileSize, False)
    Next

    GetImageFiles.FilesList = arImages()
    GetImageFiles.FilesCount = lFileCount
    
    'clear static variables for the next new search.
    If NewSearch Then
        lFileCount = 0
        Erase arImages
    End If
    
    Set objFolder = Nothing
    Set objFile = Nothing
    Set fso = Nothing

End Function


Test example:
Code:
Sub Test()

    Dim tFoundFiles As FOUND_FILES
    Dim element As Variant
    Dim sMyList As String
    Dim sFolderPath As String
    
    sFolderPath = ThisWorkbook.Path & "\MyImages\"
    If Len(Dir(sFolderPath)) Then
        tFoundFiles = GetImageFiles(FolderPath:=sFolderPath, MinFileSize:=50000)
        If tFoundFiles.FilesCount Then
            For Each element In tFoundFiles.FilesList
                sMyList = sMyList & "*" & element & vbNewLine
            Next element
            sMyList = "Image Files found : " & tFoundFiles.FilesCount & vbNewLine & vbNewLine & sMyList
            MsgBox sMyList
        Else
            MsgBox "Path :'" & sFolderPath & "' Has no file images with the specified criteria."
        End If
    Else
        MsgBox "Path :'" & sFolderPath & "' not found!"
    End If


End Sub
 
Last edited:

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,632
Office Version
2016
Platform
Windows
Actually, after taken a propper look at that routine, I found that it is not correct because it is recursive and the variables are lost .

Here is a better approach that uses a recursive FUNCTION instead of SUB and also should return all images file types :

In a Standard Module:
Code:
Option Explicit

Type FOUND_FILES
    FilesList() As String
    FilesCount As Long
End Type

Function GetImageFiles(FolderPath As String, MinFileSize As Double, Optional ByVal NewSearch As Boolean = True) As FOUND_FILES

    'define variables
    Dim fso As Object
    Dim objFolder As Object
    Dim objFolders As Object
    Dim objF As Object
    Dim objFile As Object
    Dim objFiles As Object
    Dim strFileName As String
    
    Static lFileCount As Long
    Static arImages() As String

    'set file system object
    Set fso = CreateObject("Scripting.FileSystemObject")

    'set folder object
    Set objFolder = fso.GetFolder(FolderPath)

    'set files
    Set objFiles = objFolder.Files
    Set objFolders = objFolder.subfolders

    'list all images in folder
    For Each objFile In objFiles
        If InStr(1, ".jpeg.jpg.bmp.png.tiff.raw", Split(objFile.Name, ".")(UBound(Split(objFile.Name, "."))), vbTextCompare) Then
            If objFile.Size >= MinFileSize Then
                strFileName = objFile.Name
                ReDim Preserve arImages(lFileCount)
                arImages(lFileCount) = strFileName
                lFileCount = lFileCount + 1
            End If
        End If
    Next

    'go through all subflders
    For Each objF In objFolders
        Call GetImageFiles(objF.Path, MinFileSize, False)
    Next

    GetImageFiles.FilesList = arImages()
    GetImageFiles.FilesCount = lFileCount
    
    'clear static variables for the next new search.
    If NewSearch Then
        lFileCount = 0
        Erase arImages
    End If
    
    Set objFolder = Nothing
    Set objFile = Nothing
    Set fso = Nothing

End Function


Test example:
Code:
Sub Test()

    Dim tFoundFiles As FOUND_FILES
    Dim element As Variant
    Dim sMyList As String
    Dim sFolderPath As String
    
    sFolderPath = ThisWorkbook.Path & "\MyImages\"
    If Len(Dir(sFolderPath)) Then
        tFoundFiles = GetImageFiles(FolderPath:=sFolderPath, MinFileSize:=50000)
        If tFoundFiles.FilesCount Then
            For Each element In tFoundFiles.FilesList
                sMyList = sMyList & "*" & element & vbNewLine
            Next element
            sMyList = "Image Files found : " & tFoundFiles.FilesCount & vbNewLine & vbNewLine & sMyList
            MsgBox sMyList
        Else
            MsgBox "Path :'" & sFolderPath & "' Has no file images with the specified criteria."
        End If
    Else
        MsgBox "Path :'" & sFolderPath & "' not found!"
    End If


End Sub

Great!


Thanks so much for your time .

It's working great.


I am learning from this forum and I appreciate that.


Edit:::

What's the difference between

My path

FolderPath = ThisWorkbook.Path & "\MyImages"


And yours?
FolderPath = ThisWorkbook.Path & "\MyImages"

I am confused
 
Last edited:

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
7,493
Office Version
2016
Platform
Windows
Please, ignore the previous function and use this more flexible & versatile which takes a new optional argument for searching subfolders (By default, the function doesn't search subfolders):

Code:
Option Explicit

Type FOUND_FILES
    FilesList() As String
    FilesCount As Long
End Type

Function GetImageFiles(ByVal FolderPath As String, Optional ByVal SearchSubFolders As Boolean = False, Optional ByVal MinFileSize As Double, Optional ByVal NewSearch As Boolean = True) As FOUND_FILES

    'define variables
    Dim fso As Object
    Dim objFolder As Object
    Dim objFolders As Object
    Dim objF As Object
    Dim objFile As Object
    Dim objFiles As Object
    Dim strFilePath As String
    Dim strFileName As String

    Static lFileCount As Long
    Static arImages() As String

    'set file system object
    Set fso = CreateObject("Scripting.FileSystemObject")

    'set folder object
    Set objFolder = fso.GetFolder(FolderPath)

    'set files
    Set objFiles = objFolder.Files
    Set objFolders = objFolder.subfolders

    'list all images in folder
    For Each objFile In objFiles
        If InStr(1, ".jpeg.jpg.bmp.png.tiff.raw", Split(objFile.Name, ".")(UBound(Split(objFile.Name, "."))), vbTextCompare) Then
            If objFile.Size >= MinFileSize Then
                strFilePath = objFile.Path
                strFileName = objFile.Name
                ReDim Preserve arImages(lFileCount)
                arImages(lFileCount) = strFilePath & strFileName
                lFileCount = lFileCount + 1
            End If
        End If
    Next

    'go through all subflders
    If SearchSubFolders Then
        For Each objF In objFolders
            Call GetImageFiles(objF.Path, False, MinFileSize, False)
        Next
    End If

    GetImageFiles.FilesList = arImages()
    GetImageFiles.FilesCount = lFileCount
    
    'clear static variables for the next new search.
    If NewSearch Then
        lFileCount = 0
        Erase arImages
    End If
    
    Set objFolder = Nothing
    Set objFile = Nothing
    Set fso = Nothing

End Function

Test example:
Code:
Sub Test()

    Dim tFoundFiles As FOUND_FILES
    Dim element As Variant
    Dim sMyList As String
    Dim sFolderPath As String
    
    sFolderPath = ThisWorkbook.Path & "\MyImages\"
    
    If Len(Dir(sFolderPath)) Then
        tFoundFiles = GetImageFiles(FolderPath:=sFolderPath, SearchSubFolders:=True, MinFileSize:=50000)
        If tFoundFiles.FilesCount Then
            For Each element In tFoundFiles.FilesList
                sMyList = sMyList & "*" & element & vbNewLine & vbNewLine
            Next element
            sMyList = "Total Image Files found : " & tFoundFiles.FilesCount & vbNewLine & vbNewLine & sMyList
            Debug.Print sMyList
            MsgBox sMyList
        Else
            MsgBox "Path :'" & sFolderPath & "' Has no file images with the specified criteria."
        End If
    Else
        MsgBox "Path :'" & sFolderPath & "' not found!"
    End If


End Sub

What's the difference between

My path

FolderPath = ThisWorkbook.Path & "\MyImages"


And yours?
FolderPath = ThisWorkbook.Path & "\MyImages"

I am confused
I don't see any difference.

Late Edit:
I see what you mean, the last Anti-Slash character is required when using the Dir function so the string passed to it is recognized as a folder
 
Last edited:

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,632
Office Version
2016
Platform
Windows
Okay nice.


I was talking about that last back slash "" in your path.

It failed to show while I posted.
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
7,493
Office Version
2016
Platform
Windows
Okay nice.


I was talking about that last back slash "" in your path.

It failed to show while I posted.
Let me explain :

Because in the Test routine I use the Dir function, this requires that I add a back slash at the end of the folder path otherwise the Dir Function will not recognize the string passed to it as a folder.

In fact, it is better to add Application.PathSeparator instead of the back slash so that the code also works on other operating systems other than windows where the Folder separator happens to be different than a back slash ( like in a Mac machine where I believe the path separator is :)

So the following is more correct:
Code:
sFolderPath = ThisWorkbook.Path & "\MyImages" & Application.PathSeparator
Probably a better way is to pass vbDirectory in the second argument of the Dir function so it explicitly tells the Dir function that we mean a folder.

Something like this should work whether you add a back slash at the end or not :
Code:
    sFolderPath = ThisWorkbook.Path & "\MyImages"
    If Len(Dir(sFolderPath, [B][COLOR=#ff0000]vbDirectory[/COLOR][/B])) Then
       [COLOR=#008000]'rest of your code .....[/COLOR]
 
Last edited:

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,632
Office Version
2016
Platform
Windows
Okay well understood.

Which means that it is time for me to review my codes for possible updates.

In that case will this:

Code:
sFolderPath = ThisWorkbook.Path & "\MyImages"
    If Len(Dir(sFolderPath, [B][COLOR=#ff0000]vbDirectory[/COLOR][/B])) Then
       [COLOR=#008000]'rest of your code .[/COLOR]
Do the work of the application.pathSeparator?


Making it run on other systems as well?
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
7,493
Office Version
2016
Platform
Windows
Okay well understood.

Making it run on other systems as well?
Yes. ....Adding vbDirectory should work fine accross different OS(s) with or without adding Application.PathSeparator

BTW,
don't use the first code . Instead use the second code in post #6
 
Last edited:

Forum statistics

Threads
1,082,360
Messages
5,364,920
Members
400,815
Latest member
Joaquin Phoenix

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top