I have put together a cumbersome script that takes my email messages and puts them into a Word document and saves it in a chosen folder.
--This script saves email messages to a folder of your choice as a Word document. It is important that "Show Project Gallery at Startup" is deselected under preferences General Tab
global folderpath_, file_, listOfFiles, filecount, ext1, a_attExists
tell application "Finder" --Finder 1
--Extract Name & Path of Destination Folder
display dialog "This script process only sent messages ," & return & "you should be in the sent box," & return & "PROCEED or NOT" buttons {"Yes", "No"} default button "Yes" --Checks in sent messages a
if button returned of result is "Yes" then --IF 1
set folderpath_ to (choose folder with prompt "Select the Destination Folder")
display dialog ("The destination Chosen is: " & return & folderpath_ as string) & return & "is this correct" & return buttons {"yes", "no"} default button "Yes" --Check correct folder
if button returned of result is "Yes" then --IF 2
set listOfFiles to {} --list of all files in Folder chosen
set filelist to every file of folderpath_
repeat with currentFile in filelist
set currentFileName to (the name of currentFile)
copy currentFileName to the end of listOfFiles
end repeat
set filecount to count every item in listOfFiles
tell application "Mail" -- Mail 1
set messCollection to selection --Allows for multiple message selection
repeat with selectMessage in messCollection
tell selectMessage
set background color to red -- indicates message already processed
set subject_ to subject
set subject_ to (my FixFileName(subject_)) --strip bad characters
set content_ to content
set recipients_ to to recipients -- list
set ccattachments to {}
set cc_ to cc recipients -- list
set ccNames to {} --Holder list of names sent to
set ccAddresses to {}
set ccipNames to {} --holder list of names copied to
set bcc_ to bcc recipients -- list
set sent_ to date sent
repeat with recip_ in recipients --sets up list of names sent to
copy name of recip_ to end of ccNames --create list names
end repeat
repeat with ccip_ in cc recipients -- create list names copied
copy name of ccip_ to end of ccipNames
end repeat
end tell
--Extract Initials person message sent to
activate "mail"
try
if count ccNames is greater than 1 then --IF 3
choose from list of ccNames
set a_name to result as string
set a to (count words in a_name) --Checks # words in name
if a is greater than 1 then --IF 4
set a_name2 to {}
repeat with a from 1 to count words in a_name
set a_name2 to a_name2 & character 0 of word a of a_name --collects 1st letters of recipients name
end repeat
set a_name to a_name2 ---Changes name to Initials
else
set a_name to character 1 of a_name
end if --IF 4
end if
set file_ to folderpath_ & "EM to " & a_name & " " & subject_
set subject to my Filename(subject_)
my makeADoc(ccNames, cc_, sent_, subject_, content_)
on error
set ccNames to address of first recipient of item 1 of selectMessage
set subject_ to my Filename(subject_)
my makeADoc(ccNames, cc_, sent_, subject_, content_)
end try
activate "Mail"
--Extract Attachments
tell application "Mail" -- Mail 2
set attachcnt to 1
repeat with attach from 1 to count every mail attachment of selectMessage --Cycles through every attachment
try
set a_att to the name of mail attachment attach of selectMessage as string --name of attachment
display dialog "The proposed file name for attachment is. Click Acceptable with any edits to Accept or Change to have a Att plus a number added to file name " default answer a_att buttons {"Acceptable", "Change", "skip"} default button "Acceptable"
if button returned of result is "Acceptable" then --IF 5
set a_att to my ParseName(text returned of result) --just to get ext
display dialog (count of words in a_att)
set a_att to a_att & "." & ext1
else if button returned of result is "Change" then -- then change attachment file name
set a_att to my ParseName(text returned of result)
set a_att to subject_ & " Att-" & attachcnt & "." & ext1
else
exit repeat
end if -- IF 5
set attachcnt to attachcnt + 1
set a_att to my Filename(a_att) --check if file exists
set folderpath_ to folderpath_ as string
save mail attachment attach of selectMessage in folderpath_ & a_att
end try
activate "mail"
end repeat
end tell --Mail 2
end repeat
end tell --Mail 1
end if -- IF 2
end if -- IF 3
end tell --1 Finder
-----------------------------------------
on FixFileName(str) --Deletes characters that cannot be used in file names
set fixed_string to {}
set bad_char to {":", "/"}
repeat with c from 1 to (count every character in str)
if bad_char contains (character c of str) then
set end of fixed_string to "-"
else
set end of fixed_string to (character c of str)
end if
end repeat
fixed_string as string
end FixFileName
---------------------------------------
on Filename(str)
tell application "Finder"
activate "finder"
set fileCheck to str
filecount = filecount + 1
set filecheckType to "No"
repeat with n from 1 to filecount --Check proposed file name against each possibility
repeat with n1 from 1 to filecount --Check to see if file name exists
if fileCheck = item n1 of listOfFiles then
set filecheckType to "Yes"
exit repeat --exits the repeat loop if a match is found
end if
end repeat
if filecheckType is "yes" then
set fileCheck to str & " " & n
set filecheckType to "No"
end if
end repeat
set str to fileCheck
end tell
end Filename
-----------------------------------------
on makeADoc(ccNames, cc_, sent_, subject_, content_)
tell application "Microsoft Word"
set newDoc to make new document
insert text "To :" & ccNames & return at end of text object of newDoc
insert text "CC :" & cc_ & return at end of text object of newDoc
insert text "Date Sent :" & sent_ & return & return at end of text object of newDoc
insert text "Subject :" & subject_ & return & return at end of text object of newDoc
insert text content_ at end of text object of newDoc --Adds Message text
delay 2
save as newDoc file name folderpath_ & subject_ --file_ Saves Document with file name of the subject in email message
close every document
end tell
end makeADoc
------------------------------------
on ParseName(str) --Takes attachment name and strips extension
set d to AppleScript's text item delimiters
set AppleScript's text item delimiters to "."
set str to every text item of str as list
set AppleScript's text item delimiters to " "
set str to every text item of str as text
set strcnt to count of words in str
set str3 to {}
set ext1 to last word of str
if strcnt is greater than 2 then
repeat with n from 1 to strcnt - 1
set str2 to word n of str
set str3 to str3 & str2
end repeat
else
set str3 to word 1 of str
--display dialog str3
end if
set str3 to str3 as string
set str to my replaceChars(str3)
end ParseName
---------------------------------
on replaceChars(thisText) --Removes spaces
set d to AppleScript's text item delimiters
set AppleScript's text item delimiters to the " "
set the itemList to every text item of thisText
set AppleScript's text item delimiters to the ""
set thisText to the itemList as string
set AppleScript's text item delimiters to ""
return thisText
set AppleScript's text item delimiters to d
end replaceChars
Unfortunately it is very slow and what I would like to do instead is open my mail message and print it as a PDF. I have found a couple of scripts that helped with this but cannot figure out how to enter the intended file name in the save as box that appears wi this script.
tell application "Mail"
set theMsgs to selection
repeat with i from 1 to count of theMsgs
with timeout of 1 second
try
open item i of theMsgs
end try
end timeout
end repeat
end tell
set maxloops to 100
set process_name to "Mail"
activate application process_name
tell application "System Events"
tell process process_name
keystroke "p" using command down
set prdlg to 0 # Initialize loop variable
set lcnt to 0 # Counter to prevent infinit loops
repeat until prdlg is not 0
if exists sheet 1 of window 1 then
set prdlg to 1
set prdlgref to a reference to sheet 1 of window 1
set wtype to "sht"
end if
set lcnt to lcnt + 1
if (lcnt) > maxloops then
display dialog "Reached Max Loops waiting for print dialog to open."
return
end if
end repeat
click menu button "PDF" of prdlgref
set lcnt to 0
repeat until exists menu item "Save as PDF." of menu 1 of menu button "PDF" of prdlgref
set lcnt to lcnt + 1
if (lcnt) > maxloops then
display dialog "Reached Max Loops waiting for Save as PDF dropdown to open."
return
end if
end repeat
click menu item "Save as PDF." of menu 1 of menu button "PDF" of prdlgref
set lcnt to 0
repeat until exists window "Save"
set lcnt to lcnt + 1
if (lcnt) > maxloops then
display dialog "Reached Max Loops waiting for save dialog to open."
return
end if
end repeat
end tell
I cannot figure out how to reference the Save As box in the save command that results from selecting Pint as a PDF. Some of the code from the first script would be used to generate the file name.
Any help Greatly appreciated.
Thanks Peter
Browser: Safari 533.19.4
Operating System: Mac OS X (10.6)