Re: Copy Entire Message [script]

[Allen Watson]

Title: Re: Copy Entire Message [script]

On or near 1/3/01 11:59 AM, Neil at [EMAIL PROTECTED] observed:

> on 1/3/01 1:41 PM, Allen Watson at [EMAIL PROTECTED] wrote:
>
>> The script "Messages to Disk" will do what you want. My version, based on
>> the work of several earlier scripters, can be found at my scripts web site
>> below. Currently at v2.0, a v2.1 will be posted shortly that allows saving
>> to the desktop as well as to a specified folder.
>
> Thanks Allen.  
> But it can't just copy the message to the clipboard without saving another
> text document?  I looked at the script, but it was a little too complicated
> for me to try to play with.

Here you go. Actually, this is LOTS SHORTER, so I am including it as text. Paste it in Script Editor and save it as a compiled script, suggested name, "Message to clipboard".

property pFolderPath : ""
global ctype
property rewrapping : true

(*Part of this routine was originally written by Dan Crevier and David Cortright.
Some modifications were made.*)

on run {}
    tell application "Microsoft Entourage"
        activate
        set theSelection to the current messages
        set reportProgress to true
        if theSelection is not {} then
            set theMessage to item 1 of theSelection
            if the class of theMessage is incoming message or ¬
                the class of theMessage is outgoing message then
                my ProcessMessage(theMessage)
            end if
        else
            
            display dialog "You need to select at least one email or news message " & ¬
                "in order to use this script." with icon note buttons {"OK"} default button "OK"
        end if
    end tell
end run
(*This routine gets the selected message and calls the other routines
to do the work on the message. *)
on ProcessMessage(theMessage)
    tell application "Microsoft Entourage"
        if class of theMessage is outgoing message then
            set {theBody, theFolder} to {content, name of storage} of theMessage
            -- Reform paragraphs to allow automatic wrapping in Word
            if rewrapping then
                repeat while theBody contains return & " "
                    set theBody to my SearchReplace(theBody, return & " ", return)
                end repeat
                set theBody to my SearchReplace(theBody, return & tab, return)
                set theBody to my SearchReplace(theBody, return & return, "��")
                set theBody to my SearchReplace(theBody, return, " ")
                set theBody to my SearchReplace(theBody, "��", return & return)
            end if
            
            set theSub to subject of theMessage
            try
                set theDate to time sent of theMessage
            on error theErr
                --    display dialog theErr
                set theDate to "Unknown (unsent?)"
            end try
            try
                set allRecip to every recipient of theMessage
                set theRecip to ""
                repeat with temp in allRecip
                    try
                        set theRecip to theRecip & display name of address of temp & " <" & address of address of temp & ">" & return & "    "
                    on error
                        set theRecip to theRecip & address of address of temp & " <" & address of address of temp & ">" & return & "    "
                    end try
                end repeat
            on error theErr
                --                display dialog theErr
                set theRecip to "Unknown or unset"
            end try
            set theText to "To: " & theRecip & return
            set theText to theText & "Sent: " & theDate & return
            set theText to theText & "Subject: " & theSub & return & return
            set theText to theText & theBody & return
        else if class of theMessage is incoming message then
            set {theBody, theFolder} to {content, name of storage} of theMessage
            -- Reform paragraphs to allow automatic wrapping in Word
            if rewrapping then
                repeat while theBody contains return & " "
                    set theBody to my SearchReplace(theBody, return & " ", return)
                end repeat
                set theBody to my SearchReplace(theBody, return & tab, return)
                set theBody to my SearchReplace(theBody, return & return, "��")
                set theBody to my SearchReplace(theBody, return, " ")
                set theBody to my SearchReplace(theBody, "��", return & return)
            end if
            
            try
                set allRecip to every recipient of theMessage
                set theRecip to ""
                repeat with temp in allRecip
                    try
                        set theRecip to theRecip & display name of address of temp & " <" & address of address of temp & ">" & return & "    "
                    on error
                        set theRecip to theRecip & address of address of temp & " <" & address of address of temp & ">" & return & "    "
                    end try
                end repeat
            on error theErr
                --                display dialog theErr
                set theRecip to "Unknown or unset"
            end try
            set theText to "To: " & theRecip & return
            set theSub to subject of theMessage
            set theDate to time sent of theMessage
            set theSender to sender of theMessage
            set {s1, s2} to {display name of theSender, address of theSender}
            set theText to theText & "From: " & s1 & " <" & s2 & ">" & return
            set theText to theText & "Sent: " & theDate & return
            set theText to theText & "Subject: " & theSub & return & return
            set theText to theText & theBody & return
        else if class of theMessage is draft window then
            set {theBody, theFolder} to {content, name of storage} of theMessage
            set theSub to subject of theMessage
            --    set theDate to time sent of theMessage
            set theDate to "Unsent"
            set theRecip to to recipients of theMessage
            --    set {s1, s2} to {display name of theSender, address of theSender}
            set theText to "To: " & theRecip & return
            set theText to theText & "Sent: " & theDate & return
            set theText to theText & "Subject: " & theSub & return & return
            set theText to theText & theBody & return
        end if
        try
            set subjectstr to subject of theMessage
        on error
            set subjectstr to "<no subject>"
        end try
        if subjectstr is equal to "" then set subjectstr to "<no subject>"
    end tell
    display dialog "Message \"" & subjectstr & "\" copied to clipboard." buttons {"OK"}
    set the clipboard to theText
end ProcessMessage

-- routine to do a search and replace on text
on SearchReplace(mainString, searchString, replaceString) -- Parameters: search, replace, the String
    set olddelis to AppleScript's text item delimiters
    
    set AppleScript's text item delimiters to (searchString)
    --tell me to
    set theList to (every text item of mainString)
    
    set AppleScript's text item delimiters to (replaceString)
    set theString to theList as string
    
    set AppleScript's text item delimiters to olddelis
    return theString
end SearchReplace

--
Peace,
Allen Watson <[EMAIL PROTECTED]> XNS name: =Allen Watson
A Mac family since 1984 <http://home.earthlink.net/~allenwatson/>
Applescripts for Outlook Express and Entourage: <http://homepage.mac.com/allenwatson/>