I have a bulk of images stored in a folder on the D drive, with the folder named “Images“. My boss give me a task in office to enter all the 5000 Image names in an Excel sheet along with their sizes in KB and dimensions. Doing this manually for 5000 images would take about 10 days. So, I made the following Excel VBA code to extract all the necessary information from the images and import it into Excel.
After running the VBA code, it successfully imported all the image information – their names, sizes in KB, and dimensions – within a second and with just a single click.
Thanks to this code, it saved me from 10 days of tedious work.
Images in my Images Folder in D Drive
VBA CODE
Sub GetImageInfo()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim fileName As String
Dim outputRow As Integer
' Define the folder path (replace with your actual path)
Dim folderPath As String
folderPath = "d:\Images\"
' Initialize FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Check if the folder exists
If objFSO.FolderExists(folderPath) Then
' Set starting row for data output
outputRow = 1
' Set reference to the folder
Set objFolder = objFSO.GetFolder(folderPath)
' Clear existing data in columns A, B, and C
Range("A:C").ClearContents
' Loop through each file in the folder
For Each objFile In objFolder.Files
' Check if it's an image file
If IsImage(objFile.Path) Then
' Write image name to column A
Cells(outputRow, 1).Value = objFile.Name
' Write image size in KB to column B
Cells(outputRow, 2).Value = Round(objFile.Size / 1024, 0) ' Convert bytes to KB and round off
' Get image dimensions and write them to column C
Dim dimensions As String
dimensions = GetImageDimensions(objFile.Path)
' Replace spaces with "x" and remove trailing "x"
dimensions = Replace(dimensions, " ", "")
If Right(dimensions, 1) = "x" Then
dimensions = Left(dimensions, Len(dimensions) - 1) ' Remove the last "x"
End If
Cells(outputRow, 3).Value = dimensions
' Move to the next row
outputRow = outputRow + 1
End If
Next objFile
MsgBox "Image names, sizes, and dimensions have been listed successfully.", vbInformation
Else
MsgBox "The specified folder does not exist.", vbExclamation
End If
' Cleanup
Set objFile = Nothing
Set objFolder = Nothing
Set objFSO = Nothing
End Sub
' Function to check if a file is an image
Function IsImage(filePath As String) As Boolean
Dim fileExt As String
fileExt = LCase(Right(filePath, Len(filePath) - InStrRev(filePath, ".")))
IsImage = (fileExt = "jpg" Or fileExt = "jpeg" Or fileExt = "png" Or fileExt = "bmp" Or fileExt = "gif")
End Function
' Function to get image dimensions from file properties
Function GetImageDimensions(filePath As String) As String
Dim objShell As Object
Dim objFolder As Object
Dim objFolderItem As Object
' Create Shell object
Set objShell = CreateObject("Shell.Application")
' Get folder object
Set objFolder = objShell.Namespace(Left(filePath, InStrRev(filePath, "\") - 1))
' Get folder item
Set objFolderItem = objFolder.ParseName(Right(filePath, Len(filePath) - InStrRev(filePath, "\")))
' Retrieve dimensions from file properties
GetImageDimensions = objFolder.GetDetailsOf(objFolderItem, 31) & " x " & objFolder.GetDetailsOf(objFolderItem, 32)
' Cleanup
Set objFolderItem = Nothing
Set objFolder = Nothing
Set objShell = Nothing
End Function
Below is the Result After Run the Above VBA Code in Excel
Join Our WhatsApp Group
Nazim Khan (Author) 📞 +91 9536250020
[MBA in Finance]
Nazim Khan is an expert in Microsoft Excel. He teaches people how to use it better. He has been doing this for more than ten years. He is running this website (TechGuruPlus.com) and a YouTube channel called "Business Excel" since 2016. He shares useful tips from his own experiences to help others improve their Excel skills and careers.
