John’s Technical Blog

‘ Based on a script to automate Excel with VBscript by Richard L. Mueller

‘ Demonstrates several additional functions including

‘ 1) Launching applications

‘ 2) using SendKeys to control application

‘ 3) useing Sleep to pause execution during the script

‘ 4) Arrays

‘ I wrote this script to help me update the IPTC data of images

‘ I had downloaded the data from MySQL and put it in an Excel spreadsheet

‘ Each line of the spreadsheet contains the file name and the desired IPTC information

‘ I leverage IrfanView to insert the IPTC information into each photograph

‘ This IPTC information is later read by the server using PHP when I upload the pictures to my photography web site

‘ You have a royalty-free right to use, modify, reproduce, and

‘ distribute this script file in any way you find useful, provided that

‘ you agree that the copyright owner above has no warranty, obligations,

‘ or liability for such use.

Option Explicit

Dim objExcel, strExcelPath, objSheet, intRow

dim fileName, pictureTitle, pictureDescription, keywords, categoryID, thisYear, originalDate, filesys

‘ Bind to Excel object.

On Error Resume Next

Set objExcel = CreateObject("Excel.Application")

If Err.Number <> 0 Then

On Error GoTo 0

WScript.Echo "Excel application not found."

WScript.Quit

End If

On Error GoTo 0

strExcelPath = "C:\Temp\originals\tblPictures.xls"

‘ Open specified spreadsheet and select the first worksheet.

objExcel.WorkBooks.Open strExcelPath

Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

dim category(9)

category(1) = "Plants"

category(2) = "Animals"

category(3) = "Landscapes"

category(4) = "Textures"

category(5) = "Structures"

category(6) = "Miscellaneous"

category(7) = "John"

category(8) = "People"

category(9) = "Transportation"

dim WshShell

Set WshShell = WScript.CreateObject("WScript.Shell")

Set filesys = CreateObject("Scripting.FileSystemObject")

‘Get copyright symbol - VBScript does not have a way to do an alt-0169 combination

Dim charMap

charMap = WshShell.Run("CharMap")

WScript.Sleep 250

WshShell.AppActivate charMap

WScript.Sleep 250

WshShell.SendKeys "{TAB}{TAB}{RIGHT 3}{DOWN 5}~"

WScript.Sleep 250

WshShell.SendKeys "%F"

WScript.Sleep 250

WshShell.SendKeys "Times New Roman"

WScript.Sleep 250

WshShell.SendKeys "%C"

WScript.Sleep 250

WshShell.SendKeys "%{F4}"

‘ Iterate through the rows of the spreadsheet after the first, until the

‘ first blank entry in the first column. For each row, bind to the user

‘ specified in the first column and set attributes.

intRow = 2

Do While objSheet.Cells(intRow, 1).Value <> ""

    originalDate = Mid(objSheet.Cells(intRow, 1).Value, 4,

    fileName = "C:\Temp\originals\" & objSheet.Cells(intRow, 1).Value

    if filesys.FileExists(fileName) Then

        pictureTitle = objSheet.Cells(intRow, 2).Value

        categoryID = objSheet.Cells(intRow, 3).Value

        pictureDescription = objSheet.Cells(intRow, 4).Value

        keywords = objSheet.Cells(intRow, 5).Value

        ‘ On Error Resume Next

       

       

        thisYear = mid(originalDate, 1, 4)

        WshShell.Run ("C:\Programs\Graphics\I-View\i_view32.exe " & fileName)

        WScript.Sleep 250

        WshShell.AppActivate "IrfanView"

        WshShell.SendKeys "i", True

        WScript.Sleep 250

        WshShell.SendKeys "%i", True

        WScript.Sleep 250

        WshShell.SendKeys "^v " & thisYear & " John A. Marsh, all rights reserved" & "{TAB}", True

        WshShell.SendKeys replace(replace(pictureDescription, "(", "{(}"), ")", "{)}") & "{TAB}John A. Marsh{TAB}", True

        WshShell.SendKeys pictureTitle & "{TAB}", True

        WScript.Sleep 250

        ‘WshShell.SendKeys frmOptions.infoInstructions.Text, True

        WshShell.SendKeys "^{TAB}" & keywords, True

        WScript.Sleep 250

        WshShell.SendKeys "^{TAB}" & category(categoryID), True

        WScript.Sleep 250

        WshShell.SendKeys "^{TAB}John A. Marsh{TAB}Photographer / Owner{TAB}John A. Marsh{TAB}http://www.johnmarshphotography.com/", True

        WScript.Sleep 250

        WshShell.SendKeys "^{TAB}" & pictureTitle, True

        WScript.Sleep 250

        WshShell.SendKeys "{TAB}", True

        WshShell.SendKeys thisYear & "{TAB}" & Mid(originalDate, 5, 2) & "{TAB}" & Mid(originalDate, 7, 2) & "{TAB}{TAB}", True

        WScript.Sleep 250

        WshShell.SendKeys "Durham{TAB}North Carolina, NC{TAB}United States of America, USA{TAB}", True

        WshShell.SendKeys "{ENTER}", True

        WScript.Sleep 250

        WshShell.SendKeys "%o", True

        WScript.Sleep 250

        WshShell.SendKeys "%{F4}"

        WScript.Sleep 250

    end if

    intRow = intRow + 1

Loop

‘ Close workbook and quit Excel.

objExcel.ActiveWorkbook.Close

objExcel.Application.Quit

‘ Clean up.

Set objExcel = Nothing

Set objSheet = Nothing

WScript.Echo "Done"

Sub IrfanviewIPTC(fileName)

‘Add IPTC data to image via SendKeys commands to IrfanView

’start application

‘Dim appIrfanView

‘appIrfanView = Shell("C:\Programs\Graphics\I-View\i_view32.exe " & fileName)

End Sub