I really hate it how digital cameras now create files that are stupidly big, every photo that I use - and most of those that others use only ever stay on the screen. So why do we need them saved at 5120×3825 eating about 4Mb each?!
In a large multi-user environment these massive images quickly eat up alot of disk space. I figured you could save alot of disk space by automatically resizing the images down if they are bigger than a certain size, so I got cracking on a VBScript to do this for me. The script uses the Windows Image Acquisition Automation Library to scale down files bigger than a certain size (1280 pixels wide) to 1280×1024 pixels
A trial run on 2500 files (1Gb) took just under 10mins on my laptop and reduced the total size to 340Mb after scaling around half of the files. Sorted! Maybe not the neatest code ever, but it works for me! Here’s the script…
option explicit
const maxWidth = 1280
const newWidth = 1280
const newHeight = 1024
Dim objFSO, objLogFile, totalReduction, totalSize, niceTotalSize, niceTotal, imgTotal
Set objFSO = CreateObject("scripting.filesystemobject")
Set objLogFile = objFSO.createtextfile("imgSquash.log", True)
if (Wscript.Arguments.Count = 0) then
Wscript.Echo "Usage: cscript imgSquash.vbs [PATH]"
objLogFile.writeline "No <path> argument specified on command line... Exiting"
Wscript.quit(101)
end if
Wscript.Echo "imgSquash starting @ " & time & " " & date
objLogFile.writeline "imgSquash starting @ " & time & " " & date
CheckFolder (objFSO.getfolder(WScript.Arguments.Item(0)))
niceTotal = byteValue(totalReduction)
niceTotalSize = byteValue(totalSize)
Wscript.Echo "Reclaimed total of " & niceTotal & " of " & niceTotalSize & " in " & imgTotal & " images!"
objLogFile.writeline "Reclaimed total of " & niceTotal & " of " & niceTotalSize & " in " & imgTotal & " images!"
Wscript.Echo "Logfile imgSquash.log saved."
Wscript.Echo "imgSquash completed @ " & time & " " & date
objLogFile.writeline "imgSquash completed @ " & time & " " & date
Sub CheckFolder(objCurrentFolder)
Dim strDate, strOutput, objNewFolder, objFile, img, IP, status
Dim oldName, oldWidth, oldHeight, oldSize, newFile, reduction
For Each objFile In objCurrentFolder.Files
if ucase(right(objFile.Path, 3)) = "JPG" OR ucase(right(objFile.Path, 4)) = "JPEG" then
Set img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
img.LoadFile objFile.Path
status = "No action required"
if img.width > maxWidth then
oldName = objFile.Path
oldWidth = img.width
oldHeight = img.height
oldSize = objFile.size
IP.Filters.Add IP.FilterInfos("Scale").FilterID
IP.Filters(1).Properties("MaximumWidth") = newWidth
IP.Filters(1).Properties("MaximumHeight") = newHeight
Set img = IP.Apply(img)
Img.SaveFile objFile.Path & ".tmp"
Set newFile = objFSO.GetFile(objFile.Path & ".tmp")
reduction = oldSize - newFile.size
totalReduction = totalReduction + reduction
totalSize = totalSize + oldSize
imgTotal = imgTotal + 1
status = "Resized image from " & oldWidth & "x" & oldHeight & " to " & img.Width & "x" & img.Height & ". Reclaimed " & byteValue(reduction)
set img = nothing
set ip = nothing
objFSO.deletefile objFile.Path
objFSO.movefile oldName & ".tmp", oldName
end if
Wscript.Echo objFile.Path
objLogFile.writeline objFile.Path & " --> " & status
end if
Next
For Each objNewFolder In objCurrentFolder.subFolders
CheckFolder objNewFolder
Next
End Sub
function byteValue(val)
Dim unit, mult
mult = 1024
If val > mult Then
val = val/mult
unit = " KB"
If val > mult Then
val = val/mult
unit = " MB"
If val > mult Then
val = val/mult
unit = " GB"
If val > mult Then
val = val/mult
unit = " TB"
End If
End If
End If
End If
byteValue = int(val) & unit
End function
run from the command line: cscript imgSquasher.vbs [path]