--Author: Paul Berkowitz -- Adaptation par Bernard Rey
tell application "Microsoft Entourage"
try
set theContacts to selection as list
if class of item 1 of theContacts is not in {contact, group} then
error number -128
else
display dialog "Enregistrer les catégories" & return & return & "• des contacts sélectionnés ?" & return & return & "• tous les contacts ?" buttons {"Annuler", "Sélection", "Tous"} default button "Sélection" with icon 1
if button returned of result = "Annuler" then
return
else if button returned of result = "Tous" then
set howMany to "all"
set theContacts to (every contact)
else
set howMany to "sel"
end if
end if
on error
display dialog "Aucun contact n'étant sélectionné, voulez-vous enregistrer les catégories de TOUS les contacts ?" buttons {"Annuler", "Tous"} default button "Tous" with icon 1
if button returned of result = "Annuler" then
return
else
set howMany to "all"
set theContacts to (every contact)
end if
end try
set AppleScript's text item delimiters to {", "}
repeat with theItem in theContacts
if class of theItem = contact then
my ProcessContact(theItem)
else if howMany ≠ "all" then -- don't bother going through groups if all contacts are being processed
my ProcessGroup(theItem)
end if
end repeat
beep
display dialog "Terminé !" buttons {"OK"} default button "OK" with icon 1
end tell
to ProcessContact(theContact)
tell application "Microsoft Entourage"
tell theContact
set theCategoryIDs to its category
set theCategories to {}
repeat with i from 1 to count theCategoryIDs
set end of theCategories to name of item i of theCategoryIDs
end repeat
set AppleScript's text item delimiters to {", "}
set theCategories to theCategories as string
set AppleScript's text item delimiters to {""}
set description to theCategories
end tell
end tell
end ProcessContact
to ProcessGroup(theItem)
tell application "Microsoft Entourage"
set theEntries to content of every group entry of theItem
repeat with theEntry in theEntries
set {dName, eAddress} to {display name, address} of theEntry
repeat 1 times
if eAddress = "" then -- probably an embedded group
try
set theGroup to group dName
my ProcessGroup(theGroup, num)
exit repeat -- go on to next group member
end try
end if
set foundContacts to find eAddress
if foundContacts = {} then
try
if dName starts with "\"" then set dName to text 2 thru -2 of dName -- equivalent to display name without quotes
set foundContacts to {contact dName} -- contact without email address
end try -- leave as {}
end if
repeat with theContact in foundContacts -- whether 0, 1 or more
my ProcessContact(theContact)
end repeat
end repeat
end repeat
end tell
end ProcessGroup