Moving pictures from Photos to Microsoft Word - Applescript is slow

Hi all,

I’ve been working on this script for my 86 year old father. He has whole bunch of images (with titles on them) that need to be insert (or replace existing) in a word document, albeit with the title added automatically as an caption.

I tried the option (asked Uncle Google) of using Tables and inserting the Picture in one Cell and the Caption in another below. But this does not work at all, as it is very difficult to re-position the table once it is in Word.

So I tried to simulate the Word command “Insert Caption” using a normal (floating) shape with the caption inserted in a text box just below the picture. This now works (after a long battle with the positioning of the image on the page).

However … When I run this script on my MB Air, it is slow, but acceptable. On my fathers iMac (Late 2012, with 12 GB Memory, High Sierra 10.13.2) it is VERY slow. it takes over a minute to get transfer the image (run the script).

Am I doing something terribly wrong? (the older version, the one using tables did not have this issue)

Here’s the script:


-- Export selected Picture from Photos. Import it into Microsoft Word and add the  "Photos"'s Title attribute as Caption below it.
--
-- (c) Sverrir Jonsson, December 2017
--
-- Used to trannsfer the selected picture in "PHOTOS" to "Microsoft Word"
-- Script called from MS Word using the "AppleScript" function)
-- Note:
--		Some of the logic is coded in VBA in Word. Stuff like the exct positioning of the image (snap to left|right margin etc)
--		If someone wants to see the whole thing just drop me a note....
--
--		There are a quite a few posts showing a Table based solution to the problem of automatically adding a caption to an image
--		but it is almost impossible to move the Tables around or to re-size them. 
--		There is one caveat though. After the script has returned, the use needs to manually group the Image and the Caption.
--		This is due to a "bug" in both the MS Word AppleScript lbrary, as well as the VBA Object Model on the Mac.
--
--		One more thing: There are no proper Error Handlers (Try...) will add those during next re-factoring
--
-- Test setup:
-- 		To test this script, create a word document, type in at least 100 characters (just hit some random keys...)
-- 		then comment out the following line.... before hitting RUN, open Photos and select one picture
--set myresults to InsertImageWithCaption("NewPicture!Figure!Caption!1100!50!50!1!1!0!0!18000!58320!0!15110") as string

on InsertImageWithCaption(asParam)
	set asStatus to "Error" as string
	set destFolder to "WordTemp" as string
	set imageTitle to "" as Unicode text
	set destpath to "" as string
	set results to "" as string
	set imageID to "" as string
	
	-- Split the Parameter string from Word. 
	-- Note: Position and size paramters are all multiplied by 100. Need to be divided again (done to avoid passing decimals - Avoid isssues with Point and Comma conversion)
	log asParam
	set tid to AppleScript's text item delimiters
	set AppleScript's text item delimiters to "!"
	set myParams to text items of asParam
	set AppleScript's text item delimiters to tid
	
	set myAction to item 1 of myParams
	set myCaptionLabel to item 2 of myParams
	set myCaptionStyleSheet to item 3 of myParams
	set myCaptionHeight to (item 4 of myParams) / 100
	
	set myAnchorStart to (item 5 of myParams) + 1
	set myAnchorEnd to (item 6 of myParams) + 1
	
	set myRelHorPos to item 7 of myParams
	set myRelVerPos to item 8 of myParams
	set myWrapType to item 9 of myParams
	set myWrapSideType to item 10 of myParams
	set myLeftPos to (item 11 of myParams) / 100
	set myTopPos to (item 12 of myParams) / 100
	set myHeight to (item 13 of myParams) / 100
	set myWidth to (item 14 of myParams) / 100
	
	
	tell application "Photos"
		activate
	end tell
	-- Here comes the Magic  Export and re-size the currently selected image in "Photos".....	
	set {destpath, imageTitle, imageID} to ExportSelectedImage(myWidth)
	set pictureAltText to imageTitle & "|" & imageID & "|" & (current date)
	
	
	-- Now deal with Microsoft Word .... This is done in Applescript to avoid conversion errors when transferring unicode text
	tell application "Microsoft Word"
		activate
		-- set screen updating to false ' Bug: Not implemented in AS Library ...
		-- crate anchor based on current selection....
		set myRange to create range active document start (start of content of text object of selection) + 1 end (end of content of text object of selection) + 1
		set myAnchor to create range active document start (start of content of text object of selection) + 1 end (end of content of text object of selection) + 1
		-- log "myAnchor: Start= " & (start of content of myAnchor) & ", End= " & (end of content of myAnchor)
		if myAction = "ReplacePicture" then
			delete selection
		end if
		-- Note: 	THe image comes in at full size. Would be better to include the size paramters in the "make new picture" command, 
		--			but the "keep aspect ration" element, does not work during "make"
		set pictureShapeNew to make new picture at myRange ¬
			with properties {file name:destpath as text, save with document:true, anchor:myAnchor, relative vertical position:myRelVerPos, relative horizontal position:myRelHorPos, top:myTopPos, left position:myLeftPos}
		set wrap type of wrap format of pictureShapeNew to myWrapType
		set wrap side of wrap format of pictureShapeNew to myWrapSideType
		set allow overlap of wrap format of pictureShapeNew to true
		-- Re-Size the image
		set lock aspect ratio of pictureShapeNew to true
		set width of pictureShapeNew to myWidth
		set picHeightNew to height of pictureShapeNew
		-- set height of pictureShapeNew to picHeightNew (Not needed, as aspect ration is locked)
		
		set relative vertical position of pictureShapeNew to 1 -- wdRelativeVerticalPositionPage
		set relative horizontal position of pictureShapeNew to 1 -- wdRelativeHorizontalPositionPage
		
		-- Make sure the picture is positioned correctly. All position paramters are relative to the Page. This makes it easier to find the correct position
		set left position of pictureShapeNew to myLeftPos
		set top of pictureShapeNew to myTopPos
		select pictureShapeNew
		set myAnchor to create range active document start (start of content of anchor of pictureShapeNew) + 1 end (end of content of anchor of pictureShapeNew) + 1
		
		-- Create a text box for the caption, just below the picture just inserted
		set VposCaption to (top of pictureShapeNew) + picHeightNew + 2 -- 2 points below the image
		set HposCaption to left position of pictureShapeNew
		-- log "Vert. Pos Caption: " & VposCaption & ", Hor. Pos Caption: " & HposCaption
		set myTBox to make new text box at active document with properties ¬
			{text orientation:horizontal, anchor:myAnchor, relative vertical position:1, relative horizontal position:1, top:VposCaption, left position:HposCaption, width:myWidth, height:myCaptionHeight}
		set wrap type of wrap format of myTBox to myWrapType
		set wrap side of wrap format of myTBox to myWrapSideType
		set allow overlap of wrap format of myTBox to true
		
		-- Get the "Text Frame" from the "Text Box"
		set myTextFrame to text frame of myTBox
		set textwrapping allowed of myTextFrame to true
		set myTextFrameRange to text range of myTextFrame
		set style of myTextFrameRange to myCaptionStyleSheet
		set text of myTextFrameRange to ""
		
		insert caption at before myTextFrameRange caption label myCaptionLabel title (": " & imageTitle as Unicode text) caption position caption position below
		
		--   Remove the empty paragraph in front of the Caption...
		delete text object of paragraph 1 of myTextFrameRange
		
		-- Need to fit the text box to the caption text..... "Manual auto fit...."
		repeat while (overflowing of myTextFrame)
			set myTBoxHeight to height of myTBox
			set height of myTBox to (myTBoxHeight + myCaptionHeight - 4)
		end repeat
		
		-- Of course it would be niche to group he image and the caption, but the Word AS Library does not have a "Group" command
		-- (And ... it does not work in VBA either ....)
		
		select myTBox
		set asStatus to "OK!" & (name of pictureShapeNew) & "!" & (name of myTBox) & "!" & (pictureAltText) as Unicode text
		-- end tell
	end tell
	
	return asStatus
end InsertImageWithCaption


on ExportSelectedImage(picWidthNew)
	
	set myHomeFolder to path to home folder as string
	log "Home Folder: " & myHomeFolder
	set destFolder to "WordTemp" as string
	set imageTitle to "" as Unicode text
	set destpath to "" as string
	set results to "" as string
	set imageID to "" as string
	
	-- Make sure a temporary folder exists
	tell application "Finder"
		if not (exists folder destFolder of folder myHomeFolder) then
			make new folder at myHomeFolder with properties {name:destFolder}
		end if
		set destFolder to myHomeFolder & destFolder & ":"
		delete every item of folder destFolder
		log "Destination Folder: " & destFolder
	end tell
	
	-- Now deal with Photos...
	tell application "Photos"
		set listSelectedPhotos to (get selection)
	end tell
	if listSelectedPhotos is {} then
		tell application "Finder"
			activate
			display dialog "Only select one picture" buttons {"Ok"} default button 1
		end tell
	else
		tell application "Photos"
			-- activate
			set selectedphoto to first item of listSelectedPhotos
			set imageTitle to name of selectedphoto as Unicode text
			set fname to filename of selectedphoto as text
			set destpath to destFolder & fname as text
			set imageID to id of selectedphoto
			export listSelectedPhotos to (destFolder as alias) without using originals
		end tell
		-- Resize the Image exported from Photos to 330DPI, and max width of myWidth (specifified as 72 DPI value)
		set destpath to ResizePicture(destFolder, picWidthNew)
	end if
	
	tell application "Photos"
		-- Mark the Selected Photo as "Favorite" to make it easier to see if it has been used or not.
		-- Also use two Keywords "Moved"  and "Waiting" to be able to select only remaining items in Album
		--		To use this feature, all pictures to be "processed" (or moved) should have the keyword "Waiting" applied in the Photos app
		-- Need to pass the "Keywords" ("Waiting" [Biðstaða]] and "Transferred" [Flutt]) as  Parameters..... Re-factoring task...
		set myWaiting to "Waiting" -- "Biðstaða"
		set myMoved to "Moved" -- "Flutt"
		set KeyWordList to keywords of selectedphoto
		-- log "Keywords : " & KeyWordList
		
		if KeyWordList is missing value then
			set KeyWordListNew to {myMoved}
		else
			set KeyWordListNew to {}
			set itemsToDelete to {myWaiting, myMoved}
			repeat with i from 1 to count KeyWordList
				if {KeyWordList's item i} is not in itemsToDelete then set KeyWordListNew's end to KeyWordList's item i
			end repeat
			set KeyWordListNew's end to {myMoved}
		end if
		set keywords of selectedphoto to KeyWordListNew
		
		set favorite of selectedphoto to true
	end tell
	
	
	
	return {destpath, imageTitle, imageID}
	
end ExportSelectedImage


on ResizePicture(destFolder, TargetWidth)
	-- re-size the picture before moving it to Word
	-- Assumption: use 330DPI to allow maximum quality printout.
	-- The width for 330DPI will be calclated as follows:  TargetWidth / 72 * 330 
	-- changed to 400, in order to allow some re-sizing of he image (upto +20%)
	-- The height will by dynamic (keeping the aspect ratio)
	-- Resulting image will always be in JPG format.
	
	-- Calculate the 400DPI image width
	set the target_length to round TargetWidth / 72 * 400 rounding as taught in school
	-- get the exported file ... Should be the only file in the "WordTemp" Folder
	tell application "Finder"
		set TempFiles to every file of folder destFolder as alias list
		set theFile to first item of TempFiles
	end tell
	
	
	tell application "Image Events"
		-- start the Image Events application
		launch
		-- open the image file
		set thisImage to open theFile
		-- log "File is open: " & theFile as text
		
		-- get dimensions of the image and scale it as required....
		tell thisImage
			copy dimensions to {W, H}
			--log "Old Width: " & W & ", Old Height: " & H
			-- determine the shortest side and then
			-- calculate the new length for the longer side
			if W is less than H then -- Portrait format
				set the scale_length to round ((H * target_length) / W) rounding as taught in school
			else -- Landscape format
				set the scale_length to round target_length rounding as taught in school
			end if
			-- perform action
			scale to size scale_length
			
			-- save the changes
			-- Note: always use the same file name to fool Apple´s Sandbox security mechanism
			save as JPEG in destFolder & "MoveToWord.jpg" with compression level high with icon
			-- purge the open image data
			close
		end tell
	end tell
	
	return destFolder & "MoveToWord.jpg" as Unicode text
	
end ResizePicture


Model: iMAC, late 2012
Browser: Safari 537.36
Operating System: Mac OS X (10.13 Developer Beta 3)

Hi yonz.

From what you say, it’s the importing into Word which is taking the long time, but you should also try just exporting from Photos and the resizing to see how much they contribute to the problem.

I can’t help with Word (which I don’t have) or with Photos (which I don’t use), but concerning the script generally:

• There’s no need to preset variables before use (eg. imageTitle, destpath, etc.) unless there’s a chance the script might try to read them before they’re set to the working values.
• There’s no need to coerce values which are already text to text, string, or Unicode text.
• The values of myRelHorPos, myrelVerPos, myWrapType, and myWrapSideType, which are derived from the parameter text, are still text when fed to Word in your script. It’s possible that automatic coercions take place at those points, but it may be a good idea to coerce those values explicitly to integer before they’re used. The other numeric strings taken from the parameter text are automatically coerced when they’re divided by 100 or have 1 added to them.
• The code which prepares the temporary destination folder might be slightly more efficient like this:

-- Make sure a temporary folder exists
tell application "Finder"
	if (exists folder destFolder of folder myHomeFolder) then
		delete every item of folder destFolder of folder myHomeFolder
	else
		make new folder at myHomeFolder with properties {name:destFolder}
	end if
	set destFolder to myHomeFolder & destFolder & ":"
	log "Destination Folder: " & destFolder
end tell

• Just below that, where the script checks that the right number of photos have been selected, it could perhaps test for one rather than for none:

-- Now deal with Photos...
tell application "Photos"
	set listSelectedPhotos to (get selection)
end tell
if ((count listSelectedPhotos) is not 1) then
	tell application "Finder"
		activate
		display dialog "Only select one picture" buttons {"Ok"} default button 1
	end tell
else
	--etc.
end if

• The round command in the StandardAdditions isn’t very efficient and its rounding as taught in school parameter is a calculated insult to those who prefer that kind of rounding. :wink: Since all the numbers in your ResizePicture() handler are positive, you could use the far more efficient and pleasing method of adding 0.5 and rounding down:

-- set the target_length to round targetWidth / 72 * 400 rounding as taught in school

set the target_length to (targetWidth / 72 * 400 + 0.5) div 1 -- Use with positive numbers only.
-- Or this works with both positives or negatives:
tell (targetWidth / 72 * 400) to set the target_length to it div 0.5 - it div 1
-- Or of course you could use a separate handler:
set the target_length to rnd(targetWidth / 72 * 400)

on rnd(n)
	return n div 0.5 - n div 1
end rnd

• The in parameter with a save command should be a file or alias specifier, not just text:

-- save the changes
-- Note: always use a specifier to satisfy Apple´s Sandbox security mechanism
save as JPEG in file (destFolder & "MoveToWord.jpg") with compression level high with icon

None of the above is likely to speed up the script very much, though. :frowning:

Hi all.

First of all … thanks Nigel for your comments and hints. That helped cleaning up some of the stuff.

However, I ended up re-writing the whole thing. Moved all the MS-WORD related logic to VBA and kept the PHOTOS related logic in AppleScript. This now works like a charm!

Note: When exporting the image I always use the same filename. This is done to circumvent the SandBox mechanism in MacOs. You will be asked once to allow Word to access the file.


-- Export selected Picture and add its title element as Caption
--
-- (c) Sverrir Jonsson, December 2017
--
-- Used to trannsfer the selected picture to WORD
-- Script called from MS Word using the "AppleScript" function)

-- set retVal to ExportOnly(15110)
-- log retVal

on ExportOnly(myWidth)
	-- This is the interface to WORD. Word triggers this event and passes one string as parameter. 
	-- Similarly on return the event passes one string back to WORD
	set PicWidth72 to (myWidth / 100)
	set {destpath, imageTitle, imageID, NewPicHeight, NewPicWidth} to ExportSelectedImage(PicWidth72)
	
	set retVal to imageTitle & "|" & imageID & "|" & destpath & "|" & NewPicHeight & "|" & NewPicWidth
	return retVal
end ExportOnly

on ExportSelectedImage(picWidthNew)
	
	set myHomeFolder to path to home folder as string
	log "Home Folder: " & myHomeFolder
	set destFolder to "WordTemp" as string
	set imageTitle to "" as Unicode text
	set destpath to "" as string
	set results to "" as string
	set imageID to "" as string
	
	-- Make sure a temporary folder exists
	tell application "Finder"
		if not (exists folder destFolder of folder myHomeFolder) then
			make new folder at myHomeFolder with properties {name:destFolder}
		end if
		set destFolder to myHomeFolder & destFolder & ":"
		delete every item of folder destFolder
		log "Destination Folder: " & destFolder
	end tell
	-- Now deal with Photos...
	tell application "Photos"
		set listSelectedPhotos to (get selection)
	end tell
	if listSelectedPhotos is {} then
		tell application "Finder"
			activate
			display dialog "Bara velja eina mynd" buttons {"Ok"} default button 1
		end tell
	else
		tell application "Photos"
			-- activate
			set selectedphoto to first item of listSelectedPhotos
			set imageTitle to name of selectedphoto as Unicode text
			-- log "Image Title: " & imageTitle
			set fname to filename of selectedphoto as text
			log "Image FileName: " & fname
			set destpath to destFolder & fname as text
			log "Destination Path: " & destpath
			set imageID to id of selectedphoto
			export listSelectedPhotos to (destFolder as alias) without using originals
			
		end tell
		-- Resize the Image exported from Photos to 330DPI, and max width of myWidth (specifified as 72 DPI value)
		set {destpath, NewPicHeight, NewPicWidth} to ResizePicture(destFolder, picWidthNew)
		
	end if
	
	tell application "Photos"
		-- Mark the Selected Photo as "Favorite" to make it easier to see if it has been used or not
		-- Use two Keywords Transferred ("Flutt") and Waiting ("Biðstaða") to be able to select only remaining items in Album
		-- Need to pass the "Keywords"  used as  Parameters..... Later....
		set myWaiting to "Waiting"
		set myMoved to "Transferred"
		set KeyWordList to keywords of selectedphoto
		-- log "Keywords : " & KeyWordList
		
		if KeyWordList is missing value then
			set KeyWordListNew to {myMoved}
		else
			set KeyWordListNew to {}
			set itemsToDelete to {myWaiting, myMoved}
			repeat with i from 1 to count KeyWordList
				if {KeyWordList's item i} is not in itemsToDelete then set KeyWordListNew's end to KeyWordList's item i
			end repeat
			set KeyWordListNew's end to {myMoved}
		end if
		set keywords of selectedphoto to KeyWordListNew
		
		set favorite of selectedphoto to true
	end tell
	
	
	
	return {destpath, imageTitle, imageID, NewPicHeight, NewPicWidth}
	
end ExportSelectedImage


on ResizePicture(destFolder, TargetWidth)
	-- re-size the picture before moving it to Word
	-- Assumption: use 330DPI to allow maximum quality printout.
	-- The width for 330DPI will be calclated as follows:  TargetWidth / 72 * 330 
	-- changed to 400, in order to allow some re-sizing of he image (upto +20%)
	-- The height will by dynamic (keeping the aspect ratio)
	-- Resulting image will always be in JPG format.
	
	-- Calculate the 300DPI image width
	set the target_length to round TargetWidth / 72 * 400 rounding as taught in school
	log "Expected image width (330DPI): " & target_length
	-- get the exported file ... Should be the only file in the "WordTemp" Folder
	tell application "Finder"
		set TempFiles to every file of folder destFolder as alias list
		set theFile to first item of TempFiles
	end tell
	
	
	tell application "Image Events"
		-- start the Image Events application
		launch
		-- open the image file
		set thisImage to open theFile
		-- log "File is open: " & theFile as text
		
		-- get dimensions of the image and scale it as required....
		tell thisImage
			copy dimensions to {W, H}
			--log "Old Width: " & W & ", Old Height: " & H
			-- determine the shortest side and then
			-- calculate the new length for the longer side
			if W is less than H then -- Portrait format
				set the scale_length to round ((H * target_length) / W) rounding as taught in school
			else -- Landscape format
				set the scale_length to round target_length rounding as taught in school
			end if
			-- perform action
			scale to size scale_length
			
			-- save the changes
			-- Note: always use the same file name to fool Apple´s Sandbox security mechanism
			set destpath to destFolder & "MoveToWord.jpg" as text
			save as JPEG in destpath with compression level high with icon
			-- purge the open image data
			close
		end tell
		
		-- now get the dimensions of the new file...
		set theFile to (destpath as alias)
		set thisImage to open theFile
		tell thisImage
			copy dimensions to {W, H}
			-- purge the open image data
			close
		end tell
	end tell
	set thePosixFile to POSIX path of theFile
	return {thePosixFile, H, W}
	
end ResizePicture


BTW: @Nigel: your last comment regarding the “in” Parameter needing to be a File or Alias… It seems that Image Events expect a String here…