Batch processing with Photoshop and Excel using vbs

Discussion of Automation, Image Workflow and Raw Image Workflow

Moderators: xbytor, DavideBarranca, Paul MR


Batch processing with Photoshop and Excel using vbs

Postby Seafire » Mon Nov 19, 2012 12:16 am

Hi all,

This is my first post, and it's to pay back all the help I got browsing the forum while I was trying to write the following script.

The script uses an Excel spreadsheet to populate values in a text layer in photoshop, flattening the image, saving it, and then moving to the next row in Excel.

One thing I did notice on this forum was that vbs doesn't get a lot of love, and that most scripts are written in javascript. No problem, except that I have a background in vba so the slight differences between vbs and vba were not a problem, and I was also going to be working with Excel so a little of the prior coding was also floating around in the dim recesses of that thing I call my brain.

The Background

I work in an institution that has a enormous collection of objects stored in a proprietry database system. The db allows for bulk imports of data and images using text files. Recently we have been taking digital images of the objects with a piece of card containing the registration number and adding them to the db. Unfortunately, we found out some time after we started that the unique registration numbers we were allocated were not in fact unique and we ended up with approximately 1300 objects with duplicate registration numbers. A big no-no for db's as you can imagine.

We had 2 choices about to how to fix this. Pull the 1300 objects out of the collection and reimage them with new numbers (an incredibly time consuming process), or somehow do it electronically with as little interaction with the collection as possible.

The Solution

The solution I came up with was to add the new registration numbers to the already existing (but not yet imported) images in PS, and simply then have the new cardboard registration numbers placed with the objects, without having to remove them physically from the storage rooms to the digitisation room and back etc. etc. I created an Excel spreadsheet identical to the import file I will need and allocated definite unique numbers to the duplicates in a separate column in the Excel spreadsheet, as well as a column containing the network path to the original image, and a blank column for the new filepath/image name.

The script opens PS, then opens Excel. It reads the first column of the second row (the first row has headers) which has the file path in it and passes the file to PS which opens it. PS then creates a temp small image, takes the new registration number from the 2nd column of the second row of the spreadsheet as the value for a text layer, flattens the new image, copies the whole thing, and then pastes it into the original image in a space where it is least likely to interefere with the object in the image.

It then flattens the original, saves it with a new filename and closes both it and the temp image (without saving the temp image). It then takes the new filename and stores this in the 3rd column of the spreadsheet, where I can use it in the import process for the db.

It then moves to the next row and repeats, looping through the spreadsheet until the column that contains the new registration numbers is empty. It then closes both PS and Excel.

I hope that the code will come in handy for somebody.

Code: Select all'Declare application variables
Dim myApp, myApp2

'Declare variables for Photoshop
Dim startRulerUnits, startTypeUnits, startDisplayDialogs, docSize, docsize2, mylayer, labelDoc, jpgSaveOptions

'Declare variables for Excel
Dim mynum, columnA, columnB, columnC, rownum, objWorkbook

'Declare the variables that share data
Dim ImgURL, NewFileName, filePath

'Open Photoshop and set preferences

Set myApp= CreateObject("Photoshop.Application")

' Save the current preferences
startRulerUnits = myApp.Preferences.RulerUnits
startTypeUnits = myApp.Preferences.TypeUnits
startDisplayDialogs = myApp.DisplayDialogs

'photoshop settings
myApp.Preferences.RulerUnits = 1
myApp.Preferences.TypeUnits = 1
myApp.DisplayDialogs = 3

'Open Excel, set variables and retrieve data

Set myApp2= CreateObject("Excel.Application")

Set objWorkbook = myApp2.Workbooks.Open("insert your file path between quotation marks")

myApp2.Application.Visible = True

columnA = "A"
columnB = "B"
columnC = "C"
rownum = 2

ImgURL = myApp2.Range(columnA & rownum).Value

mynum =  myApp2.Range(columnB & rownum).Value

' Loop through the Excel spreadsheet until finished, opening images and saving them with a new filename.

Do Until mynum = ""

Set docRef = myApp.Open(ImgURL)

'Set the x and y values of the new temp document
docSize = 600
docSize2 = 250

' create a new temp document
Set labelDoc = myApp.Documents.Add(docSize, docSize2, 72, "Label")

'Create a text layer with the value from the Excel spreadsheet
Set mylayer = labelDoc.ArtLayers.Add
myLayer.Kind = 2
myLayer.textItem.Size = 120
myLayer.textItem.Contents = mynum
myLayer.Translate 40,120

'Paste the newly created temp document into the old image
myApp.ActiveDocument = labelDoc
myApp.ActiveDocument = docRef
docRef.ActiveLayer.Translate -2200,1500

'Save the file with a new filename
filePath = docRef.Path
NewFileName = Left(docRef.Name,8) & "_NewRegNum.jpg"
NewFileName = filePath & NewFileName

Set jpgSaveOptions = CreateObject("Photoshop.JPEGSaveOptions")
jpgSaveOptions.quality = 12

docRef.saveAs NewFileName, jpgSaveOptions, True, extType

'Save the new filename and path back to the Excel spreadsheet
myApp2.Range(columnC & rownum).Value = NewFileName

'change the variables and run again
rownum = rownum +1

ImgURL = myApp2.Range(columnA & rownum).Value

mynum =  myApp2.Range(columnB & rownum).Value


' Reset application preferences
myApp.Preferences.RulerUnits = startRulerUnits
myApp.Preferences.TypeUnits = startTypeUnits
myApp.DisplayDialogs = startDisplayDialogs

'Quit Photoshop, save the Excel file and quit Excel



Return to “Automation & Image Workflow”

Who is online

Users browsing this forum: No registered users and 12 guests