Blog of Travis Hydzik

Decided to learn Photoshop VBScripting, don’t know why I didn’t do this sooner, I now have scripts to automatically generate my blog thumbnails (as below), and add little Google Maps markers on them (see here).

A few constants to change in the script (edit with Notepad);

• RESIZEWIDTH – thumbnail width
• RESIZEHEIGHT – thumbnail height
• IGNOREVERTICAL – should vertical (portrait0 images be ignored (I like to do these manually as I crop them to landscape)
• SUFFIX – thumbnail suffix

To run it, simply place the script in your image folder (make sure to take a backup) and execute the file.
auto-resize-images-v0.1.vbs

Public Const RESIZEWIDTH = 150
Public Const RESIZEHEIGHT = 113

Public Const IGNOREVERTICAL = True
Public Const SUFFIX = "-th"

Dim spath
spath = Mid(WScript.ScriptFullName, 1, InStrRev(WScript.ScriptFullName, "\", -1, vbBinaryCompare))

Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")

Dim foldero
Set foldero = fso.GetFolder(spath)

Dim fileo
Dim sfile

For Each fileo In foldero.Files
    'only modify jpg files
    sfile = fileo.Name
    If InStrRev(sfile, ".jpg", -1, vbTextCompare) = Len(sfile) - 3 Then
        resize spath & sfile
    End If
Next

MsgBox "Complete."

Sub resize(sfilename)

    Set WshShell = WScript.CreateObject("WScript.Shell")
    Set colProcessList = GetObject("Winmgmts:").ExecQuery("Select * from Win32_Process")

    Dim found
    found = False

    For Each objProcess In colProcessList
        If StrComp(objProcess.Name, "photoshop.exe", vbTextCompare) = 0 Then
            found = True
            Exit For
        End If
    Next

    Dim appRef
    If found Then
        Set appRef = GetObject(, "Photoshop.Application")
    Else
        Set appRef = CreateObject("Photoshop.Application")
    End If

    Do While appRef.documents.Count
       appRef.activeDocument.Close 2 'dont' save
    Loop

    Dim originalRulerUnits
    originalRulerUnits = appRef.Preferences.RulerUnits
    appRef.Preferences.RulerUnits = 1 'pixels

    Dim docRef
    Set docRef = appRef.Open(sfilename)

    Dim modified
    modified = False

    If docRef.Width >= docRef.Height Then 'horizontal photo
            If docRef.Width <> RESIZEWIDTH Then 'proceed if not already resized
                docRef.ResizeImage RESIZEWIDTH 'preserves aspect ratio
                modified = True
            End If
    Else 'verticle photo
        If Not IGNOREVERTICAL Then 'proceed
            If docRef.Height <> RESIZEHEIGHT Then 'proceed if not already resized
                docRef.ResizeImage , RESIZEHEIGHT 'preserves aspect ratio
                modified = True
            End If
        End If
    End If

    If modified Then 'only save if the image was modified
        Dim jpgSaveOptions
        Set jpgSaveOptions = CreateObject("Photoshop.JPEGSaveOptions")
        jpgSaveOptions.Quality = 8

        'calculate the new file name
        Dim newfilename
        newfilename = Mid(sfilename, 1, Len(sfilename) - 4) & SUFFIX & ".jpg"

        docRef.SaveAs newfilename, jpgSaveOptions, True, 2 'for psLowercase
    End If

    docRef.Close 2 'dont' save

    appRef.Preferences.RulerUnits = originalRulerUnits

End Sub