Re-Save and compress images from a folder

[kelly mort]

Hello,
So I have been trying to find a solution to my image compression issue for a while now and I came across this code in vb. Net

I have no idea how to understand it. But I have the feeling it's closer to my need.

I have a folder which contains these images of various sizes that I want to reduce their sizes. As low as 30kb to 50kb is okay. I am not interested in the quality here if that will be an obstacle.

So that when I run the code, then we look into that folder and locate all images above the 50kb then re-save them to that 50kb.

Yeah that's what I can think of now.

If there is a better way to achieve this please highlight that for me.

Doing it manually will not be an option here since there may be few images involved. Say 700

Code 1 - a given sample

[COLOR=#0000FF]Private[/COLOR] [COLOR=#0000FF]Class[/COLOR] JpegTools
     [COLOR=#0000FF]Private[/COLOR] codecs [COLOR=#0000FF]As[/COLOR] ImageCodecInfo() = ImageCodecInfo.GetImageEncoders()
     [COLOR=#0000FF]Private[/COLOR] quality [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Long[/COLOR]

     [COLOR=#0000FF]Public[/COLOR] ici [COLOR=#0000FF]As[/COLOR] ImageCodecInfo = [COLOR=#0000FF]Nothing[/COLOR]
     [COLOR=#0000FF]Public[/COLOR] ep [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]New[/COLOR] EncoderParameters()
     [COLOR=#0000FF]Public[/COLOR] compressionRatio [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Long[/COLOR]

     [COLOR=#0000FF]Public[/COLOR] [COLOR=#0000FF]Sub[/COLOR] [COLOR=#0000FF]new[/COLOR]([COLOR=#0000FF]ByVal[/COLOR] _compressionRatio [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Long[/COLOR], [COLOR=#0000FF]Optional[/COLOR] [COLOR=#0000FF]ByRef[/COLOR] errMsg [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]String[/COLOR] = [COLOR=#800080]"[/COLOR][COLOR=#800080]"[/COLOR])

         compressionRatio    = _compressionRatio
         [COLOR=#0000FF]If[/COLOR] compressionRatio < [COLOR=#000080]0[/COLOR] [COLOR=#0000FF]then[/COLOR] compressionRatio = [COLOR=#000080]0[/COLOR]
         [COLOR=#0000FF]If[/COLOR] compressionRatio > [COLOR=#000080]100[/COLOR] [COLOR=#0000FF]then[/COLOR] compressionRatio = [COLOR=#000080]100[/COLOR]
         quality             = ([COLOR=#000080]100[/COLOR] - compressionRatio)

         [COLOR=#0000FF]Try[/COLOR]
             [COLOR=#0000FF]For[/COLOR] [COLOR=#0000FF]Each[/COLOR] codec [COLOR=#0000FF]As[/COLOR] ImageCodecInfo [COLOR=#0000FF]In[/COLOR] codecs
                 [COLOR=#0000FF]If[/COLOR] codec.MimeType = [COLOR=#800080]"[/COLOR][COLOR=#800080]image/jpeg"[/COLOR] [COLOR=#0000FF]Then[/COLOR]
                     ici = codec
                 [COLOR=#0000FF]End[/COLOR] [COLOR=#0000FF]If[/COLOR]
             [COLOR=#0000FF]Next[/COLOR]

             ep.Param([COLOR=#000080]0[/COLOR]) = [COLOR=#0000FF]New[/COLOR] EncoderParameter(System.Drawing.Imaging.Encoder.Quality, quality)
         [COLOR=#0000FF]Catch[/COLOR] ex [COLOR=#0000FF]As[/COLOR] Exception
             errMsg = ex.Message
         [COLOR=#0000FF]End[/COLOR] [COLOR=#0000FF]Try[/COLOR]
     [COLOR=#0000FF]End[/COLOR] [COLOR=#0000FF]Sub[/COLOR]
 [COLOR=#0000FF]End[/COLOR] [COLOR=#0000FF]Class[/COLOR]

 [COLOR=#0000FF]Private[/COLOR] JpgTools [COLOR=#0000FF]As[/COLOR] JpegTools

 [COLOR=#008000][I]'[/I][/COLOR][COLOR=#008000][I] Save an Image() to a jpeg file and specify the compression % (Valid values for compressionRatio are 0 - 100)[/I][/COLOR]
 [COLOR=#0000FF]Public[/COLOR] [COLOR=#0000FF]Function[/COLOR] SaveImgToFile([COLOR=#0000FF]ByRef[/COLOR] img [COLOR=#0000FF]As[/COLOR] Image, [COLOR=#0000FF]ByVal[/COLOR] fullPathWithFileName [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]String[/COLOR], [COLOR=#0000FF]ByVal[/COLOR] compressionRatio [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Long[/COLOR], _
                               [COLOR=#0000FF]Optional[/COLOR] [COLOR=#0000FF]ByRef[/COLOR] errMsg [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]String[/COLOR] = [COLOR=#800080]"[/COLOR][COLOR=#800080]"[/COLOR]) [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Boolean[/COLOR]

     [COLOR=#0000FF]If[/COLOR] JpgTools [COLOR=#0000FF]Is[/COLOR] [COLOR=#0000FF]Nothing[/COLOR] [COLOR=#0000FF]Then[/COLOR] JpgTools = [COLOR=#0000FF]New[/COLOR] JpegTools(compressionRatio, errMsg)
     [COLOR=#0000FF]If[/COLOR] JpgTools.compressionRatio <> compressionRatio [COLOR=#0000FF]then[/COLOR] JpgTools = [COLOR=#0000FF]New[/COLOR] JpegTools(compressionRatio, errMsg)
     [COLOR=#0000FF]If[/COLOR] errMsg <> [COLOR=#800080]"[/COLOR][COLOR=#800080]"[/COLOR] [COLOR=#0000FF]then[/COLOR] [COLOR=#0000FF]Return[/COLOR] [COLOR=#0000FF]False[/COLOR]

     [COLOR=#0000FF]Try[/COLOR]
         img.Save(fullPathWithFileName, JpgTools.ici, JpgTools.ep)
     [COLOR=#0000FF]Catch[/COLOR] ex [COLOR=#0000FF]As[/COLOR] Exception
         errMsg = ex.Message
         [COLOR=#0000FF]Return[/COLOR] [COLOR=#0000FF]False[/COLOR]
     [COLOR=#0000FF]End[/COLOR] [COLOR=#0000FF]Try[/COLOR]

     [COLOR=#0000FF]Return[/COLOR] [COLOR=#0000FF]True[/COLOR]
 [COLOR=#0000FF]End[/COLOR] [COLOR=#0000FF]Function
[/COLOR]

Code 2 - a given sample

[COLOR=#666666][FONT='inherit']Int64 RequiredLength = (Int64) (3.8 * 1024);[/FONT][/COLOR]

[COLOR=#666666][FONT='inherit']//EncoderParameter epQuality = new EncoderParameter(System.Drawing.Imaging.Encoder.Quality, (int)numQual.Value);[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']int val = 50;[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']EncoderParameter epQuality = null;[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']//epQuality = new EncoderParameter(System.Drawing.Imaging.Encoder.Quality, val);[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']epQuality = new EncoderParameter(System.Drawing.Imaging.Encoder.Quality, val);[/FONT][/COLOR]

[COLOR=#666666][FONT='inherit']// Store the quality parameter in the list of encoder parameters[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']EncoderParameters epParameters = new EncoderParameters(1);[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']epParameters.Param[0] = epQuality;[/FONT][/COLOR]

[COLOR=#666666][FONT='inherit']// Create a new Image object from the current file[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']Image newImage = null;[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']newImage = Image.FromFile(strFile);[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']// Get the file information again, this time we want to find out the extension[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']FileInfo fiPicture = new FileInfo(strFile);[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']// Save the new file at the selected path with the specified encoder parameters, and reuse the same file name[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']string savepath = "TempResize\\" + fiPicture.Name;[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']newImage.Save(savepath, iciJpegCodec, epParameters);[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']FileInfo ResizedInfo = new FileInfo(savepath);[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']Int64 ResizedInBytes = ResizedInfo.Length;[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']//double somrthing = (3.8 * val) / ResizedInKb;[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']Int64 RequiredVal = (RequiredLength * val) / ResizedInBytes;[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']epQuality = new EncoderParameter(System.Drawing.Imaging.Encoder.Quality, RequiredVal);[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']// Create a new Image object from the current file[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']Image ResizedImage = null;[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']ResizedImage = Image.FromFile(strFile);[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']epParameters.Param[0] = epQuality;[/FONT][/COLOR]
[COLOR=#666666][FONT='inherit']ResizedImage.Save("TempResize\\New\\" + fiPicture.Name, iciJpegCodec, epParameters);
[/FONT][/COLOR]

 

[Jaafar Tribak]

Hi Jaafar,

Fantastic, great solution as always Two comments:
1. How did you add code to the post properly?
2. only for info: After macro ran if I open one of the images I get this message (I use Irfan View as a picture viewer and extension was and remained jpg for my test image):

View attachment 3710

If I hit "No" everything looks fine (resized image with original extension).

Thanks a lot and have a great weekend.

Hi,

1- I just copied the code from the post to a blank module and removed the erronuous added tags in red.
2- Unfortunately, the code converts all image types to bitmap files (regardless of their extension) which is a serious limitation.

EDIT:
We could exclude from resizing all image files that are not bmp files by easily amending the code in the Test routine.

 

[KeepTrying]

I see, thanks again for your great help. Yes, bitmap is a limitation but still - it's awesome
Have a great day.

 

[kelly mort]

Ok- Please ignore the previous main API code and use this one instead :

1- In a Standard Module:

Option Explicit

Private Enum PictureTypeConstants
      vbPicTypeNone = 0
      vbPicTypeBitmap = 1
      vbPicTypeMetafile = 2
      vbPicTypeIcon = 3
      vbPicTypeEMetafile = 4
End Enum
   
Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
        bmBits As LongPtr
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
        bmBits As Long
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
End Type
   
Private Type uPicDesc
    Size As Long
    Type As Long
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
        hPic As LongPtr
        hPal As LongPtr
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
       hPic As Long
       hPal As Long
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
End Type

Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7) As Byte
End Type

Private Type GdiplusStartupInput
   GdiplusVersion As Long
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
        DebugEventCallback As LongPtr
        SuppressBackgroundThread As LongPtr
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
        DebugEventCallback As Long
        SuppressBackgroundThread As Long
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
   SuppressExternalCodecs As Long
End Type

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then

    Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As LongPtr
    Private Declare PtrSafe Function FreeLibrary Lib "kernel32" (ByVal hLibModule As LongPtr) As Long
    Private Declare PtrSafe Function OleCreatePictureIndirectAut Lib "oleAut32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare PtrSafe Function OleCreatePictureIndirectPro Lib "olepro32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare PtrSafe Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As LongPtr, ByVal nCount As Long, lpObject As Any) As Long
[COLOR=#008000][B]    'GDI+ APIS.[/B][/COLOR]
    Private Declare PtrSafe Function GdiplusStartup Lib "GDIPlus" (token As LongPtr, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
    Private Declare PtrSafe Function GdiplusShutdown Lib "GDIPlus" (ByVal token As LongPtr) As Long
    Private Declare PtrSafe Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As LongPtr, ByVal hPal As LongPtr, BITMAP As LongPtr) As Long
    Private Declare PtrSafe Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As LongPtr) As LongPtr
    Private Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal BITMAP As LongPtr, hbmReturn As LongPtr, ByVal background As Long) As Long
    Private Declare PtrSafe Function GdipGetImageThumbnail Lib "GDIPlus" (ByVal Image As LongPtr, ByVal thumbWidth As Long, ByVal thumbHeight As Long, thumbImage As LongPtr, ByVal callback As LongPtr, ByVal callbackData As LongPtr) As Long

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 

    Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
    Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
    Private Declare Function OleCreatePictureIndirectAut Lib "oleAut32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare Function OleCreatePictureIndirectPro Lib "olepro32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
[COLOR=#008000][B]    'GDI+ APIS.[/B][/COLOR]
    Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
    Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
    Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As Long, ByVal hPal As Long, BITMAP As Long) As Long
    Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Long
    Private Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal BITMAP As Long, hbmReturn As Long, ByVal background As Long) As Long
    Private Declare Function GdipGetImageThumbnail Lib "GDIPlus" (ByVal Image As Long, ByVal thumbWidth As Long, ByVal thumbHeight As Long, thumbImage As Long, ByVal callback As Long, ByVal callbackData As Long) As Long

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

Private Const S_OK = 0


Public Sub ResizeImageFile(ByVal SourceFile As String, ByVal NewFileSize As Long, Optional ByVal DestinationFileCopy As String)

    Dim PicBits() As Byte, tPicInfo As BITMAP
    Dim oPic As StdPicture, oTempPic As StdPicture, oPrevTempPic As StdPicture
    Dim i As Long, j As Long
    
    Set oPic = LoadPicture(SourceFile)
    Call GetObjectAPI(oPic, LenB(tPicInfo), tPicInfo)
    Set oTempPic = CreateThumbnail(oPic, tPicInfo.bmWidth, tPicInfo.bmHeight)
    i = 1: j = 1
    
    If Not oTempPic Is Nothing Then
        Do
            Set oTempPic = CreateThumbnail(oPic, i, j)
            Call GetObjectAPI(oTempPic, LenB(tPicInfo), tPicInfo)
            Erase PicBits
            ReDim PicBits((tPicInfo.bmWidth * tPicInfo.bmHeight * 3) - 1) As Byte
            i = i + 1:     j = j + 1
            Application.StatusBar = "Processing File: " & SourceFile & "  " & tPicInfo.bmWidth * tPicInfo.bmHeight * 3 & " of " & NewFileSize & " Bits."
            DoEvents
            If UBound(PicBits) >= NewFileSize - (NewFileSize / 10) Then Exit Do
            Set oPrevTempPic = oTempPic
        Loop
        
        Application.StatusBar = False
        
        If Len(DestinationFileCopy) Then SourceFile = DestinationFileCopy
        
        SavePicture oPrevTempPic, SourceFile
    Else
        MsgBox "Cannot load file."
    End If

End Sub


Private Function CreateThumbnail(ByVal Image As StdPicture, ByVal Width As Long, ByVal Height As Long) As StdPicture
   
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
        Dim lGDIP As LongPtr, lBitmap As LongPtr, lThumb As LongPtr, hBitmap As LongPtr
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
        Dim lGDIP As Long, lBitmap As Long, lThumb As Long, hBitmap As Long
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
   
    Dim CreatheThumbnail As StdPicture
    Dim tSI As GdiplusStartupInput
    Dim lRes As Long

   tSI.GdiplusVersion = 1
   lRes = GdiplusStartup(lGDIP, tSI)
   
   If lRes = S_OK Then
      lRes = GdipCreateBitmapFromHBITMAP(Image.handle, 0, lBitmap)
      If lRes = S_OK Then
         lRes = GdipGetImageThumbnail(lBitmap, Width, Height, lThumb, 0, 0)
         If lRes = S_OK Then
            lRes = GdipCreateHBITMAPFromBitmap(lThumb, hBitmap, 0)
             Set CreateThumbnail = HandleToPicture(hBitmap, vbPicTypeBitmap)
            GdipDisposeImage lThumb
         End If
         GdipDisposeImage lBitmap
      End If
      GdiplusShutdown lGDIP
   End If
   
   If lRes Then Err.Raise 5, , "Cannot load file."
   
End Function


[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Private Function HandleToPicture(ByVal hGDIHandle As LongPtr, ByVal ObjectType As PictureTypeConstants) As StdPicture
        Dim hLib As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Private Function HandleToPicture(ByVal hGDIHandle As Long, ByVal ObjectType As PictureTypeConstants) As StdPicture
        Dim hLib As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
    
    Dim uPicDesc As uPicDesc, IID_IPicture As GUID, oPicture As IPicture
    Dim lRet As Long
   
   With uPicDesc
     .Size = Len(uPicDesc)
     .Type = ObjectType
      .hPic = hGDIHandle
     .hPal = 0
   End With
   
   With IID_IPicture
      .Data1 = &H7BF80981
      .Data2 = &HBF32
      .Data3 = &H101A
      .Data4(0) = &H8B
      .Data4(1) = &HBB
      .Data4(3) = &HAA
      .Data4(5) = &H30
      .Data4(6) = &HC
      .Data4(7) = &HAB
   End With
   
    hLib = LoadLibrary("oleAut32.dll")
    If hLib Then
        lRet = OleCreatePictureIndirectAut(uPicDesc, IID_IPicture, True, oPicture)
    Else
        lRet = OleCreatePictureIndirectPro(uPicDesc, IID_IPicture, True, oPicture)
    End If
    FreeLibrary hLib
    
    If lRet = S_OK Then
        Set HandleToPicture = oPicture
    Else
        Err.Raise 5, , "Cannot Create Picture."
    End If

End Function

2- Usage example:

The Test Macro below will reduce to 50kbs all image files located in ThsWorkbook.Path & "\Images" folder whose size are greater than 50kbs.

Sub Test()

    Dim oFSO As Object, oFolder As Object, oFile As Object
    Dim sFolderPath As String
    Dim sResizedFiles() As String
    Dim i As Long
    
    Const NEW_REDUCED_FILE_SIZE = 50000  [B][COLOR=#008000]'bits  <== change new size as required.[/COLOR][/B]
    
    sFolderPath = ThisWorkbook.Path & "\Images"   [B][COLOR=#008000]' <== change image folder path as required.[/COLOR][/B]
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(sFolderPath)
    
    For Each oFile In oFolder.Files
        If InStr(1, "jpg jpeg png gif iff bmp svg", oFSO.GetExtensionName(oFile.Path), vbTextCompare) Then
            If oFile.Size >= NEW_REDUCED_FILE_SIZE Then
                Call ResizeImageFile(SourceFile:=sFolderPath & "\" & oFile.Name, NewFileSize:=NEW_REDUCED_FILE_SIZE)
                ReDim Preserve sResizedFiles(i)
                sResizedFiles(i) = sFolderPath & "\" & oFile.Name
                i = i + 1
            End If
        End If
    Next
    
    If Len(Join(sResizedFiles)) > 0 Then
        MsgBox "(" & i & ") - Resized Image File(s) :" & vbNewLine & vbNewLine & Join(sResizedFiles, vbNewLine)
    Else
        MsgBox "No files processed."
    End If
    
End Sub

Note:
The code may take a while to execute if the files are big in size that's why the ResizeImageFile routine updates the StatusBar.

Maybe a better approach is to execute the code from a modeless userform with a label that updates the user on the progress of the resizing operation.

Hi again,

Is there a way I can set the dimension to say

275 × 314 pixels?

This had been I think 100 × 100

 

[kelly mort]

@Jaafar Tribak ,

Is there a way out for the request above?

Thanks

 

[Jaafar Tribak]

@Jaafar Tribak ,

Is there a way out for the request above?

Thanks

Don't know I am afraid.

Regards.