Save eMail messages as PDF documents & automatically name them

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)