Re-Save and compress images from a folder

kelly mort

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
2,169
Office Version
  1. 2016
Platform
  1. Windows
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:LOL:;):ROFLMAO::ROFLMAO:

Code: 
Code 1 - a given sample
Code: 
[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: 
Code 2 - a given sample
Code: 
[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]
 
Last edited:

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Sort by date Sort by votes
Okay thanks @mole999, I will give it a try.

However , I wish I can have a script embedded in my workbook that will do the job for me.

The reason being that the images will be added periodically and dragging into that desk icon always will be a bit of issue.

Regards
 
Upvote 0
play with it, the program will only reduce to what you specify. I use PhotoResize800MSOEV as the setting, works from the file name which resizes to 800x600, copy the MetaData, skip files smaller than specified size, process straight away, preserve filestamps, auto rotate from EXIF info.

Dragging a single folder of 700 files will process all the Jpg files
 
Upvote 0
@kelly mort

I have just seen your PM ----- What type of Image files are we talking about ? BMPs, JPEGs, PNGs etc ?
 
Upvote 0
The following ResizeImageFile SUB should resize image files (BMPs,JPEGs, PNGs ... etc)

Based on a few tests, the image resolution quality worked for me best with JPGES.


1- In a Standard Module:
Code: 
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]'GDI+ APIS.[/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]'GDI+ APIS.[/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
    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)) As Byte
            i = i + 1:     j = j + 1
            Application.StatusBar = "Processing: " & tPicInfo.bmWidth * tPicInfo.bmHeight * 3 & " of " & NewFileSize
            DoEvents
        Loop Until UBound(PicBits) >= NewFileSize And UBound(PicBits) <= NewFileSize + NewFileSize / 3
        
        If Len(DestinationFileCopy) Then
            SourceFile = DestinationFileCopy
        End If
        SavePicture oTempPic, SourceFile
        If Len(Dir(SourceFile)) Then MsgBox "Image File: " & SourceFile & vbNewLine & "resized." _
        & vbNewLine & "New Size: " & FileLen(SourceFile) & " Bits", vbInformation
    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 following Macro should make a 50 kbs copy of the image file C:\Test\A.JPG and save it as C:\Test\B.JPG

If you want to simply resize the source image file without making a copy of it, just omit the 3rd optional argument (DestinationFileCopy)

Code: 
Sub Test()

    Call ResizeImageFile(SourceFile:="C:\Test\A.JPG", NewFileSize:=50000, DestinationFileCopy:="C:\Test\B.JPG")

End Sub
 
Upvote 0
Cool!!!


Very sweet :).

A few issues I am facing:

1. I want to set the location to "ThisWorkbook.Path\Images" folder. Having tough time figuring it out.
2. Is it possible to scan through the folder and then resize all images above 50kb?

Regards
Kelly
 
Upvote 0
Did you try the code on a single image file ? and if so, did it work for you as expected ?

Also, Which versions of office and Windows are you using ?

1. I want to set the location to "ThisWorkbook.Path\Images" folder. Having tough time figuring it out.
Click to expand...
Are you saying that the Images folder is in the same path as the calling workbook ?

2. Is it possible to scan through the folder and then resize all images above 50kb?
Click to expand...
You could easily use FileSystemObject or just the native vba Dir,FileLen etc functions to iterate and verify the image files .

Regards.
 
Last edited:
Upvote 0
Did you try the code on a single image file ? and if so, did it work for you as expected ?
Click to expand...
Yes it did work as expected. The reason I used the "very sweet"

Also, Which versions of office and Windows are you using ?
Click to expand...
I am using office 2016 and Windows 8

Are you saying that the Images folder is in the same path as the calling workbook ?
Click to expand...

Yes

You could easily use FileSystemObject or just the native vba Dir,FileLen etc functions to iterate and verify the image files .
Click to expand...
Okay. But I don't know how to use those to iterate and do the verification.

Thanks
 
Upvote 0
You must log in or register to reply here.

Similar threads

Jaafar Tribak
  • Question
Blurring images using Direct2D & Windows Imaging Component
Replies
3
Views
236
Dan_W
D
C
  • Question
Ton of script in case anyone wants to review, maybe something useful to someone
Replies
0
Views
2K
cizzett
C
S
  • Question
Pass Parameters from VBA to AS400
Replies
0
Views
3K
speed88bump
S
Y
  • Question
SAP - Deal with the "Save As" dialog box with VBA and/or VBS
2
Replies
14
Views
29K
YounesB3
Y

Forum statistics

Threads
1,214,584
Messages
6,120,385
Members
448,956
Latest member
JPav

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top