Here is another option: a script that will back up all of your groups
to a text file, with a second script that will read the text file and
recreate the groups in Entourage:
-- Export Address Groups
-- Allen Watson 9/21/2004
-- An applescript for Microsoft Entourage
-- This script will write all Groups in your address book to
-- a file named "Address Groups List" on your Desktop. See also Import Address
-- Groups.
tell application "Microsoft Entourage"
activate
set theGroups to name of groups
set askUser to true -- Flag to control dialog
choose from list theGroups with prompt "Choose one or more groups to
export:" with multiple selections allowed
set chosenGroups to result
end tell
set AppleScript's text item delimiters to {""}
repeat with theGroup in chosenGroups
set theGroup to theGroup as text
tell application "Microsoft Entourage"
set theUsers to (display name of content of group entries of
group theGroup)
set theAddresses to (address of content of group entries of
group theGroup)
set theList to ""
end tell
repeat with i from 1 to count of items of theUsers
set aName to item i of theUsers
if (count of words in aName) > 1 then
set fname to words 1 thru -2 of aName
set lname to word -1 of aName
else
set fname to ""
set lname to aName
end if
set anAddress to item i of theAddresses
set aLine to fname & tab & lname & tab & anAddress & return
set theList to theList & aLine
end repeat
set thePath to ((path to desktop) & "Address Groups List") as text
tell application "Finder"
-- activate
set fileExists to file thePath exists
end tell
set myFileRef to open for access file thePath with write permission
try
if fileExists then
if askUser then
display dialog ¬
"File 'Desktop:Address Groups List'
exists. Replace, append, or
quit?" buttons {"Quit", "Append", "Replace"} ¬
default button "Append"
set theButton to button returned of result
set askUser to false
else
set theButton to "Append"
end if
if theButton is "Quit" then
return
else if theButton is "Append" then
-- Append to end of file
write "***" & theGroup & "***" & return to
myFileRef starting at eof
write theList to myFileRef
write return to myFileRef
close access myFileRef
else -- replace contents
set eof of myFileRef to 0
write "***" & theGroup & "***" & return to
myFileRef
write theList to myFileRef
write return to myFileRef
close access myFileRef
end if
else -- create a new file
write "***" & theGroup & "***" & return to myFileRef
write theList to myFileRef
write return to myFileRef
close access myFileRef
set askUser to false
end if
on error theErr
close access myFileRef
display dialog theErr
end try
-- end tell
tell application "Microsoft Entourage" to activate
end repeat
display dialog "Group listing saved in file on Desktop:Address Groups List"
-- Import Address Groups
-- Allen Watson 9/21/2004
-- An applescript for Microsoft Entourage.
-- This script will recreate all Groups in your address book from
-- a file named "Address Groups List" on your Desktop, which was created by the
-- script named Export Address Groups.
tell application "Finder"
set importFile to choose file of type {"TEXT"} with prompt "Select
file to import"
set fileRef to open for access importFile
set theImport to read fileRef
close access fileRef
set theRecs to paragraphs of theImport
set savedelim to AppleScript's text item delimiters
set AppleScript's text item delimiters to tab
end tell
set FirstDone to false
set linePointer to 1
repeat -- Until the "try" fails, meaning we've run out of input data
try
-- Scan until we get a group header line, which should be the
first line
set aLine to item linePointer of theRecs as text
repeat while aLine does not start with "***"
set linePointer to linePointer + 1
set aLine to item linePointer of theRecs as text
end repeat
set GroupName to text 4 thru -4 of aLine
set theEntries to {}
set linePointer to linePointer + 1
repeat while (count of theRecs) ≥ linePointer
set aLine to item linePointer of theRecs
set linePointer to linePointer + 1
if aLine = "" then exit repeat
set fname to text item 1 of aLine
set lname to text item 2 of aLine
set eMail to text item 3 of aLine
copy {fname:fname, lname:lname, eMail:eMail} to end of
theEntries
end repeat
tell application "Microsoft Entourage"
try -- Use existing group if found
set theGroup to group GroupName
on error
set theGroup to make new group with properties
{name:GroupName}
end try
repeat with anEntry in theEntries
try
set aContact to find eMail of anEntry
set aContact to item 1 of aContact
make new group entry of theGroup with
properties {content:aContact}
on error
set newEntry to fname of anEntry & " " & lname of
anEntry & " <"
& eMail of anEntry & ">"
make new group entry of theGroup with
properties {content:newEntry}
end try
end repeat
end tell
set FirstDone to true
on error theErr
display dialog "Import is complete."
exit repeat
end try
end repeat
set AppleScript's text item delimiters to savedelim
