Alan you are a gentleman and a scholar. Thanks for the script. What you’ve provided could serve the group as category need, but color me crazy, I’m interested in having each CCed contact added to my addressbook as individuals and who are assigned a color category. There will be occasions where I’ll need to email some smaller combination of people, e.g. once I know who belongs to which committees. Someday I promise to make time to learn AppleScripts!
Oh, sure. I've heard that before. ;-) Here you are. Tested a few times, but let me know if there are any bugs. Use it on a received or sent or new message in the front window, or even from a rule (but it will let you know if there are no CC's , so set the rule to run only on messages with CCs). It has various safeguards, such as as checking whether any of the CCs already exist in the Address Book by email address and/or by name: if identical in both, it just passes over, otherwise it asks you if you want to make a new contact or just add the email address or change the name. You can choose an existing category instead of making a new one every time (it might be the same company again, right?). If it's a new category, you have to set the color yourself at the end of the script, or whenever you want. It will work in 2001 or X; when I release the X version later, I'll get it to work in Unicode for all languages: this version will work for English and all Western European languages.
---Add CCs to Address Book-----------
tell application "Microsoft Entourage"
try
set theMsg to item 1 of (get current messages)
if {class of theMsg} is not in {incoming message, outgoing message} then error number -128 -- might be new draft window in front
on error
if class of front window is draft window then
save window 1
set theMsg to displayed message of window 1
else
beep
display dialog "This script only works if you first select a received or sent message, or have a new message in the front, or from a rule." buttons {"Cancel"} default button 1 with icon 0
return
end if
end try
set catNames to name of every category
display dialog "Enter a name for a new category for these CC recipients, or use an exisitng category?" & return & return & "Enter new category name:" default answer "" buttons {"Cancel", "Existing Category", "New Category"} with icon 1
if button returned of result = "Cancel" then
return
else if button returned of result = "New Category" then
set catName to text returned of result
if catName = "" then
beep
display dialog "You forgot to enter a new category name:" & return & return default answer "" with icon 2
set catName to text returned of result
if catName = "" then
beep
display dialog "Rune the script again if you wish." & return & return buttons {"Cancel"} default button 1 with icon 0
return
end if
end if
if {catName} is in catNames then
set theCat to category catName
else
set theCat to make new category with properties {name:catName}
display dialog "You will have o set the color of your new category \"" & catName & "\" at the end of the script run." buttons {"OK"} default button 1 with icon 1
end if
else -- existing category
set catName to item 1 of (choose from list catNames with prompt "Which category?")
if catName = "false" then return -- canceled
set theCat to category catName
end if
set theCCs to every recipient of theMsg whose recipient type is (cc recipient)
if theCCs = {} then
beep
display dialog "There are no CC recipients in this message." buttons {"Cancel"} default button 1 with icon 0
return
end if
repeat with i from 1 to (count theCCs)
set ccRecip to item i of theCCs
repeat 1 times
set {dName, eAddress} to ccRecip's address's {display name, address}
try
set theContact to item 1 of (find eAddress)
set conName to name of theContact
set conCat to category of theContact
if dName � conName then
if dName = "" then
set p to eAddress
else
set p to dName
end if
display dialog "You already have a contact \"" & conName & "\" with the same email address as the CC recipient \"" & p & "\"." & return & return & "Make a new contact, change the name of the contact to \"" & p & "\", or leave as is?" buttons {"Don't Add", "Change Name", "Add Contact"} with icon 2
if button returned of result = "Don't Add" then
if conCat does not contain {theCat} then set category of theContact to ({theCat} & conCat)
exit repeat -- 1 times
else if button returned of result = "Change Name" then
set {fname, lName} to my MakeName(dName, eAddress)
set first name of theContact to fname
set lName of theContact to lName
if conCat does not contain {theCat} then set category of theContact to ({theCat} & conCat)
exit repeat
end if -- if new contact, keep going
else -- if same name and same address, contact exists already
if conCat does not contain {theCat} then set category of theContact to ({theCat} & conCat)
exit repeat -- go on to next cc
end if
on error -- no exisitng contact with that email address
try
set theContact to contact dName
set conCat to category of theContact
display dialog "There is already a contact of the same name \"" & dName & "\" but not this email address." & return & return & "Add the email address to the existing contact, or make a new contact?" buttons {"Add Email Address", "Make New Contact"} with icon 2
if button returned of result = "Add Email Address" then
make new email address at theContact with properties {contents:eAddress}
if conCat does not contain {theCat} then set category of theContact to ({theCat} & conCat)
exit repeat -- 1 times
end if -- otherwise. keep going
end try
end try
set {fname, lName} to my MakeName(dName, eAddress)
make new contact with properties {first name:fname, last name:lName, email address:eAddress, category:{theCat}}
end repeat
end repeat
beep
display dialog "All done!" buttons {"OK"} default button 1 with icon 1
end tell
to MakeName(dName, eAddress)
if dName = "" then return {"", eAddress} -- use email address as name if no display name
set AppleScript's text item delimiters to {space}
set lName to text item -1 of dName
try
set fname to (text items 1 thru -2) as string
on error -- no -2, i.e. only one name
set fname to lName
set lName to "" -- usually if only one name will be a first name
end try
set AppleScript's text item delimiters to {""}
return {fname, lName}
end MakeName
--
Paul Berkowitz
