Wednesday, March 08, 2006

VBScript / Excel / SendKeys / Sleep - Solution

This is a script I wrote to help me add IPTC information to over 1200 images. It contains several techniques you might be able to use in your own VBScripts.

' 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."
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, 8)
    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}", 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

' Close workbook and quit Excel.

' 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