Script to extract names and email addresses of all recipients of an email

Hi,

Try this :

set tList to {}
tell application "Mail"
    repeat with tMsg in (get selection)
        repeat with i in (get recipients of tMsg)
            set {a, n} to {address, name} of i
            if n is missing value then
                set end of tList to (tab & tab & a) -- address only
            else
                set end of tList to (my splitName(n)) & a -- first name + tab +last name + tab + address 
            end if
        end repeat
    end repeat
end tell
set tid to text item delimiters
set text item delimiters to return
set t to tList as text -- convert list to text (one row for each item.)
set text item delimiters to tid
set tsvFile to (path to desktop as text) & "names_email_addresses.txt"
my writeToFile(t, tsvFile)

on splitName(t)
    set tid to text item delimiters
    set text item delimiters to space
    set l to text items of t
    if (count l) = 1 then -- no space
        set r to tab & t & tab -- last name only
    else
        tell l to set r to "" & (items 1 thru -2) & tab & last item & tab
    end if
    set text item delimiters to tid
    return r
end splitName

on writeToFile(t, p)
    try
        set openFile to open for access file p with write permission
        set eof of openFile to 0
        write t to openFile starting at eof
        close access openFile
    on error
        try
            close access file p
        end try
    end try
end writeToFile

Hi,

nick_harambee wrote:

I have one outstanding issue, which wasn't included in the original question. Sometimes email addresses are included in the Name of the recipient, i.e. instead of 'John Doe', it reads 'John Doe (johndoe@me.com)'. Could you script be adapted to delete any block of text (i.e. space delimited) that includes the @ symbol, so that 'John Doe (johndoe@me.com)' would return:

John<tab>Doe<tab>johndoe@me.com

Use this handler:

on splitName(t)
    if "@" is in t then -- to remove the address after the name
        set n to -3
    else
        set n to -2 -- normal name
    end if
    set tid to text item delimiters
    set text item delimiters to space
    set l to text items of t
    if (count l) = 1 then -- no space  
        set r to tab & t & tab -- last name only  
    else
        tell l to set r to "" & (items 1 thru n) & tab & (item (n + 1)) & tab
    end if
    set text item delimiters to tid
    return r
end splitName