Sorry had taken copy of DevonThink Pro’s Mail Rule and Just started editing so the headers had copy right as all rights reserved.
-- Mail Rule - AutoFile messages
-- Created by Devang Bhatt on Fri February 14 2014.
-- No Strings Attached License
(*
PURPOSE: Integrate Contacts with Emails
Plan for Contacts Management: Store iPhone contacts on iCloud, and Store Contacts used for Email filing on Mac Server / Local Computer
Check if it is a message from me or my managers
If it is then get the first TO, CC or BCC recipient name and email details who is not me or my managers and process further.
Check if the email address belongs to anyone in our Contacts
Check if it is the email address registered to a company
For this to work the company card should exist in our address book with work url set to domain name without http://
If the Company does not have a domain but uses one single email address that email address should be in company's list of emails
If the senders mailbox exists within the Company Mailbox then use that.
Else irrespective of the sender the mail is filed to the Company Mailbox
Check if Sender exists in Contacts
Check if the sender's company is set in contact card and company mailbox exists
If the sender's email is work email and company is set then try to file by that company name (Currently is in reverse)
Check if the sender's full display name mailbox exists
If the sender's email is any other type of email then try to file by that sender's full display name
Check if the domain mailbox exists
Check if the Email Display Named Mailbox exists
Check if the Email's Username Mailbox exists
Check if the Full Email mailbox exists
If No folder exists and Option_No_Folder_Folder is defined move the message there.
WIP:
Need to cache mailboxes for faster processing. DONE.
Need to cache contact lookups for faster processing.
Need to sort by from for faster processing.
*)
tell application "Mail"
--set myMessages to messages of mailbox "AutoFile"
--set myMessages to visible messages of message viewer 1
set myMessages to selected messages of message viewer 1
tell me to perform mail action with messages myMessages for rule "Mail Rule - AutoFile Messages"
end tell
using terms from application "Mail"
on perform mail action with messages theMessages for rule theRule
tell application "Mail"
set Option_File_Sent_Messages_By_To to true -- File my Messages and my Managers Messages in the Mailbox of the person who is addressed to
set Option_File_By_Contact_Name to true -- Required for Enabling Integration with Mac OS X Address Book - AKA Contacts
-- Options for Generic Filing.
set Option_File_By_Display_Name to false -- Someone <s@where.com> -> Someone
set Option_File_By_Domain_Name to false -- UserName@Email.co.in -> Email
set Option_File_By_User_Name to false -- UserName@Email.com -> UserName
-- WIP Start
-- Sort by senders domain name if it is a company domain, even if senders folder is existing
-- Set Company's work url to domain from emails, this is because some companies have different email and web domains
set Option_File_By_CompanyDomain to true
-- Sort my bosses emails with the person they are replying to
set Option_Senders_Email_Addresses_Filed_In_Recipient_MailBox to my GetMyManagersEmailAddresses()
-- WIP END
set Option_File_Multi_To_Recipients_By_First_To_Recipient_Only to true -- false is not supported since it will result to duplicates
set Option_My_Contact_Card_Emails to my GetMyEmailAddresses() as string
set Option_No_Folder_Folder to missing value -- (get mailbox "ZZZ-No Folders") -- to missing value
-- Reset the Cache of MailBoxes
set ListOfAllMailBoxes to {}
set ListOfAllMailBoxNames to {}
repeat with theMessage in theMessages -- Iteriate over the messages
set bMoved to false
if the account of mailbox of theMessage is missing value then -- If the message is not in an IMAP MailBox then
try
set OldDelimiters to AppleScript's text item delimiters
set theEmail to missing value
set theSender to sender of theMessage
try
set AppleScript's text item delimiters to {"<", ">"}
set theName to my TrimText(the first text item of theSender)
set theEmail to my ChangeToLowerCase(my TrimText(the second text item of theSender))
set theContactName to my GetContactNameFromEmailAddress(theEmail)
set AppleScript's text item delimiters to OldDelimiters
on error
set theName to theSender
set theEmail to my ChangeToLowerCase(theSender) as string
set theContactName to my GetContactNameFromEmailAddress(theEmail)
set AppleScript's text item delimiters to OldDelimiters
end try
-- First Check If it is a message that I sent.
-- Then change the Generic Sender's Details to Recipient's Details
if ((Option_File_Sent_Messages_By_To is equal to true) and (Option_My_Contact_Card_Emails contains theEmail)) then
set theRecipients to every to recipient of theMessage
if (count of theRecipients) is equal to 0 then
set theRecipients to every cc recipient of theMessage
end if
if (count of theRecipients) is equal to 1 then
try
set theNameOfRecipient to name of the first item of theRecipients as string
set theName to my TrimText(name of the first item of theRecipients as string)
set theEmail to my ChangeToLowerCase(my TrimText(address of the first item of theRecipients as string))
set theContactName to my GetContactNameFromEmailAddress(theEmail)
end try
else if Option_File_Multi_To_Recipients_By_First_To_Recipient_Only is equal to true then
repeat with theRecipient in theRecipients
set CheckRecipientAddress to the address of theRecipient as string
if Option_My_Contact_Card_Emails does not contain theEmail then -- Ignore my emails to myself
if (Option_Senders_Email_Addresses_Filed_In_Recipient_MailBox is missing value) or ((Option_Senders_Email_Addresses_Filed_In_Recipient_MailBox is not missing value) and (Option_Senders_Email_Addresses_Filed_In_Recipient_MailBox does not contain CheckRecipientAddress)) then -- Ignore my emails to my boss
try
set theNameOfRecipient to name of theRecipient as string
set theName to my TrimText(name of theRecipient as string)
set theEmail to my ChangeToLowerCase(my TrimText(address of theRecipient as string))
set theContactName to my GetContactNameFromEmailAddress(theEmail)
exit repeat
end try
end if
end if
end repeat
else
-- probably draft message
end if
end if
-- Second Check If it is a message that my Boss sent.
-- Then change the Generic Sender's Details to Recipient's Details
if (Option_Senders_Email_Addresses_Filed_In_Recipient_MailBox is not missing value) and (Option_Senders_Email_Addresses_Filed_In_Recipient_MailBox contains theEmail) then
set theRecipients to every to recipient of theMessage
if (count of theRecipients) is equal to 0 then
set theRecipients to every cc recipient of theMessage
end if
if (count of theRecipients) is equal to 1 then
try
set theNameOfRecipient to name of the first item of theRecipients as string
set theName to TrimText(name of the first item of theRecipients as string)
set theEmail to ChangeToLowerCase(TrimText(address of the first item of theRecipients as string))
set theContactName to GetContactNameFromEmailAddress(theEmail)
end try
else if Option_File_Multi_To_Recipients_By_First_To_Recipient_Only is equal to true then
repeat with theRecipient in theRecipients
set CheckRecipientAddress to the address of theRecipient as string
if (Option_My_Contact_Card_Emails does not contain theEmail) then -- It wasnt me.. ;-)
if (Option_Senders_Email_Addresses_Filed_In_Recipient_MailBox is missing value) or ((Option_Senders_Email_Addresses_Filed_In_Recipient_MailBox is not missing value) and (Option_Senders_Email_Addresses_Filed_In_Recipient_MailBox does not contain CheckRecipientAddress)) then
try
set theNameOfRecipient to name of theRecipient as string
set theName to my TrimText(name of theRecipient as string)
set theEmail to my ChangeToLowerCase(my TrimText(address of theRecipient as string))
set theContactName to my GetContactNameFromEmailAddress(theEmail)
exit repeat
end try
end if
end if
end repeat
else
-- probably corroupted message leave it for manually filing
end if
end if
--display dialog theName & "<" & theEmail & ">" & " - " & theContactName
try
set AppleScript's text item delimiters to {"@"}
set theUsername to text item 1 of theEmail as string
set theFullDomain to text item 2 of theEmail as string
set theDomain to my GetOnlyDomainName(theFullDomain) as string
set AppleScript's text item delimiters to OldDelimiters
on error
set AppleScript's text item delimiters to OldDelimiters
end try
set targetFolder to missing value
if Option_File_By_CompanyDomain is equal to true then
-- Check if the Email is comming from an Official domain of a Company
set theSenderCompany to my TrimText(my GetCompanyNameFromDomain(theFullDomain))
set targetFolder to my FindMailBox(theSenderCompany)
end if
-- First Try to find folder by sender's full contact name
if ((targetFolder is missing value or targetFolder is null) and (Option_File_By_Contact_Name is equal to true)) then
try
if theContactName is not equal to "" or theContactName is not missing value or theContactName is not null then
set targetFolder to my FindMailBox(theContactName)
end if
end try
end if
if ((targetFolder is missing value or targetFolder is null) and (Option_File_By_Contact_Name is equal to true)) then
try
if theContactName is not equal to "" and (theContactName is not missing value or theContactName is not null) then
-- Check if the ContactName has Company Details and if the MailBox exists
set theSenderCompany to my GetContactCompanyNameFromPersonName(theContactName)
set targetFolder to my FindMailBox(theSenderCompany)
end if
end try
end if
-- display dialog name of targetFolder as string
-- display dialog theContactName
-- Next try to find folder by sender's full display name
if ((targetFolder is missing value or targetFolder is null) and (Option_File_By_Display_Name is equal to true)) then
try
set targetFolder to my FindMailBox(theName)
end try
end if
-- Next try to find folder by domain name without .com etc
if ((targetFolder is missing value or targetFolder is null) and (Option_File_By_Domain_Name is equal to true)) then
try
set targetFolder to my FindMailBox(theDomain)
end try
end if
-- Next try to find folder by sender's username i.e. email front portion
if ((targetFolder is missing value or targetFolder is null) and (Option_File_By_User_Name is equal to true)) then
try
set targetFolder to my FindMailBox(theUsername)
end try
end if
try
if (targetFolder is not missing value and targetFolder is not null) then
if the (count of theMessages) is equal to 1 then
display dialog "Move to folder? " & my GetImapMailBoxPathFromFolder(targetFolder, "/")
if the button returned of the result is equal to "Ok" then
move theMessage to targetFolder
set bMoved to true
end if
else
move theMessage to targetFolder
end if
else if Option_No_Folder_Folder is not null or Option_No_Folder_Folder is not missing value then
move theMessage to Option_No_Folder_Folder
set bMoved to true
else
if theContactName is not "" or theContactName is not missing value or theContactName is not null then
log ("No Folder for: " & theContactName)
end if
end if
end try
if ((bMoved is false) and ((count of theMessages) is equal to 1)) then
-- Not Moved - Show help
display dialog "Please create a contact called '" & theName & "' OR by the name of the folder in which you want to move this message AND assign it work email as '" & theEmail & "' OR work url as '" & theFullDomain & "'."
end if
on error errMsg
if (count of theMessages) is equal to 1 then
display dialog "Main Try Errored: " & errMsg
end if
end try
end if
end repeat
end tell
end perform mail action with messages
end using terms from
-- Functions ---
property ListOfAllMailBoxes : {}
property ListOfAllMailBoxNames : {}
on FindMailBox(strName)
tell application "Mail"
set strName to my FormatMailBoxName(my TrimText(my ChangeToLowerCase(strName)))
--or (count of (get mailboxes)) is not equal to LastCountOfMailBoxes
if (my ListOfAllMailBoxes is {} or my ListOfAllMailBoxNames is {}) then
set my ListOfAllMailBoxes to every item in (get mailboxes)
repeat with i from 1 to count of my ListOfAllMailBoxes
copy (my FormatMailBoxName(my ChangeToLowerCase(name of (item i of my ListOfAllMailBoxes) as string))) to the end of the my ListOfAllMailBoxNames
end repeat
-- display dialog "Got List of Mail Boxes!"
end if
repeat with i from 1 to count of my ListOfAllMailBoxNames
set theMailBoxNameCheck to item i of my ListOfAllMailBoxNames
if theMailBoxNameCheck is equal to strName then
if my FormatMailBoxName(my ChangeToLowerCase(the (name of item i of my ListOfAllMailBoxes) as string)) is equal to strName then
return (item i of my ListOfAllMailBoxes)
else
return null
end if
end if
end repeat
return null
end tell
end FindMailBox
property Option_Replace_Folder_Name_Content_With_Space : {".", "-", "_"}
property Option_Ignore_Folder_Name_Content_Between : {"[", "]"} -- Should be in Pairs of Open Tag Character and Close Tag Characters
on FormatMailBoxName(theMailBoxName)
set strReturn to theMailBoxName
-- Replace each character in Option_Replace_Folder_Name_Content_With_Space with space i.e. replace . - and _ with space
repeat with TextItem from 1 to count of my Option_Replace_Folder_Name_Content_With_Space
set strReturn to my ReplaceText(strReturn, item TextItem of my Option_Replace_Folder_Name_Content_With_Space as string, " ")
end repeat
-- Ignore Content Between Defined Characters i.e. Company Name [Person Name] or Person Name [Company Name]
-- The text between [] is ignored
repeat with TextItem from 1 to count of my Option_Ignore_Folder_Name_Content_Between
if TextItem mod 2 is equal to 1 then
set strReturn to my Delete_Text_Between_Chars(strReturn, item TextItem of my Option_Ignore_Folder_Name_Content_Between, item (TextItem + 1) of my Option_Ignore_Folder_Name_Content_Between)
end if
end repeat
set strReturn to my ReplaceText(strReturn, " ", " ")
return my TrimText(strReturn) as string
end FormatMailBoxName
on Delete_Text_Between_Chars(SourceText, StartingChar, EndingChar)
set Clean_Text to ""
set Copy_Flag to true
repeat with this_char in SourceText
set this_char to the contents of this_char
if this_char is StartingChar then
set the Copy_Flag to false
else if this_char is EndingChar then
set the Copy_Flag to true
else if the Copy_Flag is true then
set the Clean_Text to the Clean_Text & this_char as string
end if
end repeat
return Clean_Text
end Delete_Text_Between_Chars
on GetOnlyDomainName(strFullDomain)
if strFullDomain contains "." then
set OldDelimiters to AppleScript's text item delimiters
set AppleScript's text item delimiters to {"."}
set strReturn to missing value
set Counter to 1
try
repeat
set strReturn to text item Counter of strFullDomain
if strReturn is equal to "" then
exit repeat
end if
set Counter to Counter + 1
end repeat
on error
set strReturn to text item (Counter - 2) of strFullDomain
if strReturn is equal to "co" or strReturn is equal to "com" then
set strReturn to text item (Counter - 3) of strFullDomain
end if
end try
set AppleScript's text item delimiters to OldDelimiters
return strReturn
else
return strFullDomain
end if
end GetOnlyDomainName
on GetOnlyFolderName(strFolderHirerkey)
if strFolderHirerkey contains "/" then
set OldDelimiters to AppleScript's text item delimiters
set AppleScript's text item delimiters to {"/"}
set strReturn to missing value
set Counter to 1
try
repeat
set strReturn to text item Counter of strFolderHirerkey
if strReturn is equal to "" then
exit repeat
end if
set Counter to Counter + 1
end repeat
on error
set strReturn to text item (Counter - 1) of strFolderHirerkey
end try
set AppleScript's text item delimiters to OldDelimiters
return strReturn
else
return strFolderHirerkey
end if
end GetOnlyFolderName
on GetImapMailBoxPathFromFolder(theMailBox, theDelimiter)
if theDelimiter is null or theDelimiter is missing value then
set theDelimiter to "/"
end if
tell application "Mail"
set fldContainer to theMailBox
set strReturn to name of the fldContainer
try
repeat
set fldContainer to container of fldContainer
set strReturn to name of the fldContainer & theDelimiter & strReturn
end repeat
end try
return strReturn
end tell
end GetImapMailBoxPathFromFolder
on ChangeToLowerCase(|SourceText|)
set CharList to id of |SourceText|
repeat with i from 1 to the count of CharList
if item i of CharList > 64 and item i of CharList < 91 then
set item i of CharList to ((item i of CharList) + 32)
end if
end repeat
return (string id CharList) as text
end ChangeToLowerCase
on GetMyManagersEmailAddresses()
set strReturn to ""
using terms from application "Contacts"
tell application "Contacts"
set MyCard to get my card
set MyRelations to related names of MyCard
repeat with thisRelation in MyRelations
if label of thisRelation as string is equal to "manager" then
set ManagerCards to (people whose name contains (value of thisRelation as string))
set theManager to item 1 of ManagerCards
-- repeat with theManager in ManagerCards -- Not repeating since it gets wife's email addresses also
set theManagersEmails to get emails of theManager
repeat with theEmail in theManagersEmails
set strReturn to strReturn & "," & value of theEmail as string
end repeat
-- end repeat
end if
end repeat
return text 2 thru -1 of strReturn
end tell
end using terms from
end GetMyManagersEmailAddresses
on GetMyEmailAddresses()
using terms from application "Contacts"
tell application "Contacts"
set MyCard to my card
set Option_My_Contact_Card_Emails to ""
set MyEmails to (email of MyCard)
repeat with theEmail from 1 to count of MyEmails
set Option_My_Contact_Card_Emails to Option_My_Contact_Card_Emails & "," & (value of item theEmail of MyEmails) as text
end repeat
return text 2 thru (length of Option_My_Contact_Card_Emails) of Option_My_Contact_Card_Emails
end tell
end using terms from
end GetMyEmailAddresses
on GetContactNameFromEmailAddress(|theEmailAddress|)
using terms from application "Contacts"
tell application "Contacts"
set ListOfPeople to {}
set ListOfPeople to name of people whose value of emails contains |theEmailAddress|
--display dialog (emailAddress & ": " & (count of ListOfPeople))
if ListOfPeople is not {} then
set RetVar to " " & item 1 of ListOfPeople
set RetVar to my ReplaceText(RetVar, " Mr. ", "")
set RetVar to my ReplaceText(RetVar, " Mr ", "")
set RetVar to my ReplaceText(RetVar, " Mrs. ", "")
set RetVar to my ReplaceText(RetVar, " Mrs ", "")
set RetVar to my ReplaceText(RetVar, " Miss. ", "")
set RetVar to my ReplaceText(RetVar, " Miss ", "")
set RetVar to my ReplaceText(RetVar, " Ms. ", "")
set RetVar to my ReplaceText(RetVar, " Ms ", "")
set RetVar to my ReplaceText(RetVar, " Dr. ", "")
set RetVar to my ReplaceText(RetVar, " Dr ", "")
set RetVar to my ReplaceText(RetVar, " Late Shri ", "")
set RetVar to my ReplaceText(RetVar, " Late Shree ", "")
return my TrimText(RetVar)
else
return ""
end if
end tell
end using terms from
end GetContactNameFromEmailAddress
on GetCompanyNameFromDomain(|theDomain|)
using terms from application "Contacts"
tell application "Contacts"
set ListOfCompanies to {}
set ListOfCompanies to people whose value of urls contains |theDomain| and company is true
if ListOfCompanies is not {} then
repeat with theCompany in ListOfCompanies
set ListOfURLs to urls of theCompany
repeat with theUrl in ListOfURLs
if |theDomain| is equal to value of theUrl and label of theUrl is equal to "work" then
-- display dialog label of theUrl & ": " & value of theUrl
return my TrimText(name of theCompany)
end if
end repeat
end repeat
else
return ""
end if
end tell
end using terms from
end GetCompanyNameFromDomain
on TrimText(|SourceText|)
repeat until |SourceText| does not start with " "
set |SourceText| to text 2 thru -1 of |SourceText|
end repeat
repeat until |SourceText| does not end with " "
set |SourceText| to text 1 thru -2 of |SourceText|
end repeat
return |SourceText|
end TrimText
to ReplaceText(|SourceText|, |SearchText|, |ReplacemetText|)
set {DTID, AppleScript's text item delimiters} to {AppleScript's text item delimiters, |SearchText|}
try
set {TextItems, AppleScript's text item delimiters} to {every text item of |SourceText|, |ReplacemetText|}
set {|SourceText|, AppleScript's text item delimiters} to {TextItems as text, DTID}
on error errorMessage number errorNumber -- oops
set AppleScript's text item delimiters to DTID
error errorMessage number errorNumber -- pass it on
end try
return |SourceText|
end ReplaceText