Saturday, January 20, 2018

#1 2014-05-27 02:06:18 am

devangbhatt
Member
Registered: 2011-04-24
Posts: 3

Mail Rule - AutoFile messages

Sorry had taken copy of DevonThink Pro's Mail Rule and Just started editing so the headers had copy right as all rights reserved.

Applescript:


-- 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

Last edited by devangbhatt (2014-06-05 05:26:35 am)


Filed under: mail, applescript, rule, Contact

Offline

 

Board footer

Powered by FluxBB

RSS (new topics) RSS (active topics)