G’day.
I struck a few problems when trying to modify mail, with included attachments, and save as rtf.
This script does just that. Might be useful for some of you.
It saves each email as rtf, with attachments, and with alterations, as well as a unique universal time derived name.
Regards
Santa
-- Mail rtf printer
-- Note if you install the bar code font 'IDAutomationHC39M' you can
--uncomment the bar code line. Available inside this package...
-- http://www.bizfonts.com/free/IDAutomationCode39.zip
-- Set this to the required maximum number of Attachment pages to print.
-- Must be from 1 to 9
property MaxAttachmentPages : 3
global PrintDateTimeName
global DateTimeName
global TheName
global RTFName
global RTFPath
my MainLoop()
on MainLoop()
set PathToDesktop to path to desktop as Unicode text
tell application "Mail"
set temp to every message of inbox
set CycleThroughMessages to item 1 of temp
set y to the id of CycleThroughMessages as string
set TheName to (y & ".emlx" as string)
set thePrintName to TheName
set theSendersFullName to (the sender of CycleThroughMessages) as string
-- we must only refer to date & time ONCE
-- This routine get Universal Time
copy (current date) - (time to GMT) to tempDate
set theEntireSeconds to time of tempDate -- the day time in seconds
tell application "Finder"
set {theMonth, theDays, theHours, theMinutes, theSeconds, DateTimeName} to my SetDateTimeName(theEntireSeconds, tempDate)
set PrintDateTimeName to (year of tempDate & "-" & theMonth & "-" & theDays as string) & " " & theHours & theMinutes & theSeconds & "Z"
set BarCodeDateTimeName to "(" & (year of tempDate & " " & theMonth & " " & theDays & " " as string) & theHours & " " & theMinutes & " " & theSeconds & "Z)"
set printFilePath to PathToDesktop & "RTF Documents:" & PrintDateTimeName & ".rtfd"
-- Now folder for temporary rtf's
if not (exists folder "RTF Documents" of desktop) then make new folder with properties {name:"RTF Documents"}
set RTFName to PrintDateTimeName & ".rtfd"
set ShortRTFName to PrintDateTimeName & ".rtf"
tell application "Mail"
activate
open CycleThroughMessages
tell application "System Events" to tell process "Mail"
keystroke "s" using {command down, shift down}
tell window 1
-- NOTE: A problem can arise when the emails 'Subject' field is blank
delay 2
try
select text field 1 of sheet 1
end try
delay 1
keystroke RTFName
delay 2
try
tell pop up button 1 of sheet 1
click
delay 0.5
tell menu 1
click menu item "Desktop"
end tell
end tell
end try
try
if value of checkbox "Include Attachments" of group 1 of sheet 1 = 0 then click checkbox "Include Attachments" of group 1 of sheet 1
end try
try
tell group 1 of sheet 1
tell pop up button 1
click
delay 0.5
tell menu 1
click menu item 1
end tell
end tell
end tell
end try
end tell
tell window 1
delay 4
-- click button "Save" of sheet 1
keystroke return
delay 1
keystroke return
delay 1
keystroke return
delay 2
end tell
end tell
close window 1
tell application "Finder"
delay 4
get every item of desktop -- To refresh the finder
if exists file ShortRTFName then set the name of file ShortRTFName to RTFName
delay 4
get every item of desktop -- To refresh the finder
move file RTFName to folder "RTF Documents"
delay 4
get every item of desktop -- To refresh the finder
end tell
-- Now to list attachments
set theAttachmentNames to "Attachments for " & TheName & return & return
set AttachmentWarningCount to 0
set AttachmentWarning to ""
if (count of CycleThroughMessages's mail attachments) = 0 then set theAttachmentNames to theAttachmentNames & "<None>"
repeat with theAttachment in CycleThroughMessages's mail attachments
set AName to theAttachment's name
set theAttachmentNames to theAttachmentNames & AName & return
if "." is not in characters -6 thru -3 of AName then set AttachmentWarningCount to AttachmentWarningCount + 1
end repeat
if AttachmentWarningCount = 1 then set AttachmentWarning to "Warning! There is an attachment in this email without a name extension."
if AttachmentWarningCount > 1 then set AttachmentWarning to "Warning! There are " & AttachmentWarningCount & " attachments in this email without name extensions."
-- *** This prepares cover page, just as text.
set TempSubject to subject of CycleThroughMessages as text
if TempSubject = "" then set TempSubject to "<no subject>"
set theEmail to "Universal Widgets Inc." & ¬
return & ("Reference number : " & PrintDateTimeName & ¬
return & BarCodeDateTimeName & ¬
return & "File Path is... " & ¬
return & printFilePath as string) & ¬
return & "__________________________________________________________" & ¬
return & ¬
return & "From: " & (sender of CycleThroughMessages as text) & ¬
return & "Subject: " & TempSubject & ¬
return & "Date: " & (date sent of CycleThroughMessages as text) & ¬
return & "__________________________________________________________" & ¬
return & AttachmentWarning & ¬
return & return & theAttachmentNames & ¬
return & "__________________________________________________________"
-- Now go and print the Cover Sheet
my PrintTheDarnThing(theEmail)
end tell
end tell
end tell
end MainLoop
--__________________________________ Cover Page Printing ________________________________________
on PrintTheDarnThing(theEmail)
set PathToDesktop to path to desktop as Unicode text
tell application "Finder"
tell application "TextEdit"
activate
try
set RTFPath to PathToDesktop & "RTF Documents:" & RTFName as string
open RTFPath
--set text of document frontmost to theEmail & return & text of document frontmost
set paragraph 1 of document frontmost to theEmail & return & paragraph 1 of document frontmost
-- You can alter these 'set paragraph' lines.
-- Just make sure the used font has a BOLD type set
-- if you use -BOLD
tell document frontmost
set TotalParagraphs to 14
set font of paragraphs 1 thru TotalParagraphs to "Times"
set size of paragraphs 1 thru TotalParagraphs to 14
set color of paragraphs 1 thru TotalParagraphs to {0, 0, 0}
set font of paragraphs 1 thru 2 to "Times-Bold"
set size of paragraphs 1 thru 2 to 20
set color of paragraphs 1 thru 2 to {50411, 560, 2938} -- Change to {0,0,0} for black
--set font of paragraph 3 to "IDAutomationHC39M" -- Bar Code font
set size of paragraph 3 to 14
set font of paragraphs 4 thru 5 to "Times-Bold"
set size of paragraphs 4 thru 5 to 14
set color of paragraphs 4 thru 5 to {50411, 560, 2938}
set font of word 1 of paragraph 8 to "Times-Bold"
set size of word 1 of paragraph 8 to 15
set font of word 1 of paragraph 9 to "Times-Bold"
set size of word 1 of paragraph 9 to 15
set font of word 1 of paragraph 10 to "Times-Bold"
set size of word 1 of paragraph 10 to 15
set font of paragraph 12 to "Times-Bold"
set size of paragraph 12 to 16
set color of paragraph 12 to {50411, 560, 2938}
set font of paragraph 14 to "Times-Bold"
set size of paragraph 14 to 16
set color of paragraph 14 to {40626, 22439, 544}
end tell
tell application "Finder"
try
move file RTFPath to trash
end try
end tell
tell application "System Events" to tell process "TextEdit"
keystroke "s" using {command down, shift down}
delay 2
click button "Save" of sheet 1 of window 1
delay 1
keystroke "p" using command down
tell window 1
repeat until sheet 1 exists
delay 0.5
end repeat
repeat 4 times
keystroke tab
delay 0.2
end repeat
delay 1
keystroke MaxAttachmentPages as string
delay 0.4
end tell
tell sheet "print"
keystroke return
end tell
end tell
delay 6
tell application "TextEdit"
try
close document frontmost without saving
delay 1
close document frontmost without saving
end try
end tell
end try
end tell
end tell
end PrintTheDarnThing
on SetDateTimeName(theEntireSeconds, tempDate)
try
set theDays to day of tempDate
if theDays < 10 then set theDays to "0" & theDays
set theHours to theEntireSeconds div 3600
set theMinutes to (theEntireSeconds - (theHours * 3600)) div 60
set theSeconds to theEntireSeconds - (theHours * 3600) - (theMinutes * 60)
if theHours < 10 then set theHours to "0" & theHours as string
if theMinutes < 10 then set theMinutes to "0" & theMinutes as string
if theSeconds < 10 then set theSeconds to "0" & theSeconds as string
copy the month of tempDate to tempMonth
copy ((offset of tempMonth in "jan feb mar apr may jun jul aug sep oct nov dec ") + 3) / 4 as integer to theMonth
if theMonth < 10 then copy "0" & theMonth as string to theMonth
set TempDateTimeName to (year of tempDate & "-" & theMonth & "-" & theDays as string) & " " & theHours & theMinutes & theSeconds & "Z.rtfd"
return {theMonth, theDays, theHours, theMinutes, theSeconds, TempDateTimeName}
end try
end SetDateTimeName