Die Idee ist folgende, alle Leute die jemanden über einen bestimmten Email-Account kontaktieren, sollen in eine Gruppe im Adressbuch einsortiert werden. Gibt es noch keinen Adressbuch-Eintrag zu der Email, wird ein neuer angelegt und entsprechend einsortiert.
Das ganze läuft entweder als Email-Regel oder kann auch bei Skript-Aufruf auf eine Auswahl von Nachrichten angewendet werden. Die Namen der Gruppen kann im Skript über das Property: AddressBookGroups definiert werden, ansonsten wird einfach der Account-Name als Gruppen-Name verwendet.
-- hubionmac.com 17.02.2012
-- AppleMail Script, zum Anhängen an eine Regel oder zum Anwenden auf eine Auswahl in Mail
-- Ordnet Email-Adressen in Adressbucheinträgen Gruppen zu, bzw. legt neue Einträge im an
-- und fügt diese dann einer entsprechenden Gruppe zu. (angefragt von M.Lach)
global AddressBookGroups, proccessed_mails, alreadyThere_counter, add_counter, created_counter, duplicat_counter
--liste mit Zuordnung {{< ;Account-Name,Gruppenname im Addressbuch}}
--Wenn die Zuordnung nicht passt, wird der Account-Name benutzt.
property AddressBookGroups : {{"hubionmac.com", "hubionmac"}, {"Bla.com", "BlaFasel-Group"}}
using terms from application "Mail"
on perform mail action with messages theMessages for rule theRule
try
my addEmailToAddressBook_Group(theMessages)
on error msg
display dialog msg
end try
end perform mail action with messages
on run
try
tell application "Mail"
set theMessages to selection
my addEmailToAddressBook_Group(theMessages)
end tell
on error msg
display dialog msg
end try
end run
end using terms from
on addEmailToAddressBook_Group(theMessages)
set proccessed_mails to {}
set alreadyThere_counter to 0
set add_counter to 0
set created_counter to 0
set duplicat_counter to 0
tell application "Mail"
repeat with theMessage in theMessages
set thesender to sender of theMessage
--manchmal stimmen Abensender und Antwort-Adresse nicht überein...
set replyto to reply to of theMessage
if replyto contains "< ;" then
set replyto to (characters ((offset of "< ;" in replyto) + 1) through ((offset of ">" in replyto) - 1) of replyto) as rich text
end if
set theSenderName to ""
--email adresse und ggf. Name aufsplitten
if thesender contains "< ;" then
set theMailAdress to (characters ((offset of "< ;" in thesender) + 1) through ((offset of ">" in thesender) - 1) of thesender) as rich text
set theSenderName to (characters 1 through ((offset of "< ;" in thesender) - 2) of thesender) as rich text
else
set theMailAdress to thesender
end if
--manchmal stimmen Abensender und Antwort-Adresse nicht überein... wir nehmen dann mal die Antwort-Adresse sofern diese eine andere ist
if replyto ≠ theMailAdress then set theMailAdress to replyto
--ab hier lohnt es sich nur noch weiterzumachen, wenn die Email Adresse in diesem Durchlauf noch nicht vorkam
if proccessed_mails does not contain theMailAdress then
set proccessed_mails to proccessed_mails & theMailAdress
--den Account Namen auslesen und so ggf. einer Gruppe im
--Adressbuch zuordnen, ansonsten einfach den Account namen verwenden
set theaccount to name of account of mailbox of theMessage
set thegroupname to theaccount
repeat with AddressBookGroup in AddressBookGroups
if item 1 of AddressBookGroup = theaccount then
set thegroupname to item 2 of AddressBookGroup
exit repeat
end if
end repeat
tell application "Address Book"
--gibt es die EINE Gruppe eigentlich schon? sonst anlegen
set groupexists to (count of (every group whose id does not end with "SmartGroup" and name is thegroupname)) ≥ 1
if groupexists is false then
my notifyMe("Status", "Neuigkeiten:", "Die Gruppe \"" & thegroupname & "\" gibt es noch nicht…")
make new group with properties {name:thegroupname}
save
my notifyMe("Status", "", "jetzt schon... ")
end if
--gibt es denn schon eine Person mit dieser Email-Adresse?
set foundpersons to (every person whose value of every email contains my delete_space(theMailAdress as text))
if (count of foundpersons) = 0 then
--in dem Fall gibt es die Adresse noch gar nicht, also anlegen
set thenewperson to make new person with properties {first name:theSenderName, note:"Per Mail-Skript hinzugefügt"}
make new email at end of emails of thenewperson with properties {label:"Arbeit", value:theMailAdress}
add thenewperson to group thegroupname
save
set created_counter to created_counter + 1
else if (count of foundpersons) > 0 then
repeat with theperson in foundpersons
set thispersons_groups to name of groups of theperson
if thispersons_groups contains thegroupname then
--Kontakt exisitiert bereits und wurde auch schon der entsprechendn Gruppe zugeordnet
set alreadyThere_counter to alreadyThere_counter + 1
else
--Kontakt gib es zwar schon, aber er ist noch nicht in der Gruppe
add theperson to group thegroupname
save
set add_counter to add_counter + 1
end if
--wenn es mehr als nur eine Person mit der gleichen Email gibt,
--kann man das ja zumindest mal vermerken
if (count of foundpersons) > 1 then
set duplicat_counter to duplicat_counter + 1
if note of theperson does not contain "-Email ist doppelt-" then
set note of theperson to (note of theperson & "\n-Email ist doppelt-") as text
save
end if
end if
end repeat
end if
end tell
end if
end repeat
end tell
set totalcount to created_counter + add_counter + alreadyThere_counter
my notifyMe("Status", "Neuigkeiten:", "Zur Gruppe \"" & thegroupname & "\" wurden " & totalcount - alreadyThere_counter & " Adressen hinzugefügt.\nUnverändert: " & alreadyThere_counter & "\nHinzugefügt: " & add_counter & "\nNeu angelegt: " & created_counter & "\n\ngeprüft total: " & (count of theMessages))
if duplicat_counter > 0 then
my notifyMe("Status", "Achtung:", "Von den Emails waren " & duplicat_counter & " in mehr als einem Adressbuch-Eintrag vorhanden, das kann ja gewollt sein, wurde aber in den Notizen vermerkt (Suche: Email ist doppel).")
end if
end addEmailToAddressBook_Group
to delete_space(thestring)
try
--delete every double-space...
set AppleScript's text item delimiters to " "
set theparts to every text item of thestring
set AppleScript's text item delimiters to ""
set finalparts to {}
repeat with t in theparts
if t as text is not "" then
set finalparts to finalparts & t
end if
end repeat
set AppleScript's text item delimiters to " "
set theparts to finalparts as text
set AppleScript's text item delimiters to ""
--replace spaces at the end of line (if new line comes after it) +++and at beginning
return replace_chars(replace_chars(theparts, " \r", "\r"), "\r ", "\r")
on error msg
display dialog "error on delete_space" & return & msg
end try
end delete_space
on notifyMe(theType, theTitle, theContents)
--show growl information if available otherwhise display a timedout alert
--theType -> "status" or "error"
--theTitle -> The title of the Message
--theContents -> The message/info itself
tell application "System Events"
set GrowlRunning to (count of (every process whose bundle identifier is "com.Growl.GrowlHelperApp")) > 0
end tell
if GrowlRunning is true then
tell application id "com.Growl.GrowlHelperApp"
set the allNotificationsList to ¬
{"Status", "Error"}
set the enabledNotificationsList to ¬
allNotificationsList
register as application "Address Book" all notifications allNotificationsList ¬
default notifications enabledNotificationsList ¬
icon of application "Address Book"
notify with name ¬
theType title ¬
theTitle description ¬
theContents application name "Address Book"
end tell
else
--das lassen wir hier mal sein
(**activate
if theType = "status" then
display alert (theTitle & return & return & theContents) as informational giving up after 2
else
display alert (theTitle & return & return & theContents) as warning giving up after 2
end if**)
end if
end notifyMe
to replace_chars(this_text, search_string, replacement_string)
try
if this_text contains the search_string then
set AppleScript's text item delimiters to the search_string
set the item_list to every text item of this_text
set AppleScript's text item delimiters to the replacement_string
set this_text to the item_list as string
set AppleScript's text item delimiters to ""
end if
return this_text
on error msg
display dialog "error on replace_chars" & return & msg
end try
end replace_chars