ひよこさんより
“
set theAttachment to choose file with prompt “添付ファイルを選択してください”

tell application “Mail”
　　set newMessage to make new outgoing message with properties {subject:theSubject, content:theBody & return & return}
　　tell newMessage
　　　　set visible to false –サイレントでメール作成（メールのウィンドウを表示しない）
　　　　
　　　　–受取人の指定
　　　　make new to recipient at end of to recipients with properties {name:theName, address:theAddress}
　　　　
　　　　–添付ファイルの指定
　　　　tell content
　　　　　　make new attachment with properties {file name:theAttachment} at after the last paragraph
　　　　end tell
　　　　
　　　　–メール送信
　　　　send
　　　　
　　end tell
end tell

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

tell application “Mail”
　　–特定キーワードを名前に含むフォルダ（mailbox）を抽出
　　set allPath to every mailbox whose name contains searchKeyword
　　
　　–与えられたフォルダ
　　set bList to {}
　　repeat with i in allPath
　　　　set the end of bList to getFullPath(i) of me
　　end repeat
　　
　　–結果の一覧表示
　　choose from list bList with prompt “検索結果：”
　　
end tell

–与えられたmailboxのフルパスをテキストで返す
on getFullPath(mBox)
　　tell application “Mail”
　　　　set fullPath to name of mBox
　　　　
　　　　repeat
　　　　　　set mBox to getParent(mBox) of me
　　　　　　
　　　　　　try
　　　　　　　　set aClass to class of mBox
　　　　　　on error
　　　　　　　　exit repeat
　　　　　　end try
　　　　　　
　　　　　　if aClass is not equal to mailbox then
　　　　　　　　exit repeat
　　　　　　end if
　　　　　　
　　　　　　set aName to name of mBox
　　　　　　set fullPath to aName & “/” & fullPath
　　　　end repeat
　　end tell
　　
　　return fullPath
end getFullPath

–親フォルダを取得
on getParent(aMailBox)
　　tell application “Mail”
　　　　tell aMailBox
　　　　　　try
　　　　　　　　set a to properties
　　　　　　　　set b to container of a
　　　　　　on error
　　　　　　　　return {“”, “”}
　　　　　　end try
　　　　end tell
　　end tell
　　return b
end getParent

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

tell application “Mail”
　　set enabled of every account to false
　　repeat with i in eList
　　　　set j to contents of i
　　　　tell account j
　　　　　　set enabled to true
　　　　end tell
　　end repeat
end tell

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

ぴよ〜"

sendMail(aSubject, theSender, recipientAddr, bodyText) of me

–Mail.appでメール送信を行う
on sendMail(theSubject, theSender, recipientAddr, bodyText)
　　tell application "Mail"
　　　　set newMessage to make new outgoing message with properties {subject:theSubject, content:bodyText}
　　　　tell newMessage
　　　　　　set visible to true
　　　　　　set sender to theSender
　　　　　　make new to recipient at end of to recipients with properties {address:recipientAddr}
　　　　　　
　　　　　　makeAMessageToPlain() of me
　　　　　　
　　　　　　send
　　　　end tell
　　end tell
end sendMail

–作成したメールがリッチテキストなら標準テキスト（プレーンテキスト）に直す
on makeAMessageToPlain()
　　activate application "Mail"
　　
　　tell application "System Events"
　　　　tell process "Mail"
　　　　　　–メニュー内容が「Mail.app」＞「フォーマット」＞「標準テキストにする」だったら現在リッチテキストだと判断し、コマンド実行
　　　　　　set aTitle to title of menu item 11 of menu 1 of menu bar item 8 of menu bar 1
　　　　　　
　　　　　　if aTitle = "標準テキストにする" then
　　　　　　　　–「標準テキストにする」をクリック
　　　　　　　　click menu item 11 of menu 1 of menu bar item 8 of menu bar 1
　　　　　　end if
　　　　end tell
　　end tell
end makeAMessageToPlain

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

set newList to {}
repeat with i in sbjList
　　set j to contents of i
　　if "[" is in j and "]" is in j then
　　　　set j1 to offset of "]" in j
　　　　set j2 to text (j1 + 1) thru -1 of j
　　　　set j2 to repChar(j2, " Re: ", "") of me
　　　　set j2 to repChar(j2, " ", "") of me
　　　　set the end of newList to j2
　　end if
end repeat
newList
–>{"○○の話", "○○の話", "○○の話", "○○の話"}

–文字置換ルーチン
on repChar(origText, targStr, repStr)
　　set {txdl, AppleScript’s text item delimiters} to {AppleScript’s text item delimiters, targStr}
　　set temp to text items of origText
　　set AppleScript’s text item delimiters to repStr
　　set res to temp as text
　　set AppleScript’s text item delimiters to txdl
　　return res
end repChar

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

set aFullPath to ""

set aNewFolName to "10.6,Snow Leopard"
tell application "Mail"
　　–mailboxオブジェクトを渡すのは、全メール振り分けルールからML用のもの（名称に「_ML」が入っている）
　　–を抽出して、それに対してすべて処理を行うことを考えているため。その際に入手できるのは
　　–該当するメールボックスのオブジェクト（のリスト）
　　set aMB to mailbox "ML/Apple US/ASに関係のあるもの/SyncService" –mailboxオブジェクトを作ってみた
end tell
makeAFolderIfNotExist(aNewFolName, aMB) of me

–
on makeAFolderIfNotExist(aNewFolName, aFolder)
　　–パラメータとして渡されたメールボックスオブジェクトからフルパスの階層を取得する
　　–make mailbox full-path text from Mail.app’s mailbox object
　　set aFullPath to ""
　　extraxctTextFullPathOfMBObject(aFolder) of me
　　set aNewFolFullPath to aFullPath & "/" & aNewFolName
　　set aFullPath to ""
　　
　　tell application "Mail"
　　　　–指定名称を「含む」フォルダが存在するかどうかチェック
　　　　tell aFolder
　　　　　　set tmpFolList to name of every mailbox whose name contains aNewFolName
　　　　end tell
　　　　
　　　　if tmpFolList is equal to {} then
　　　　　　try
　　　　　　　　make new mailbox at beginning with properties {name:aNewFolFullPath}
　　　　　　on error erM
　　　　　　　　display dialog erM & return & "Error in making new mail folder by name: " & aNewFolName
　　　　　　end try
　　　　end if
　　end tell
end makeAFolderIfNotExist

–Mail.appのメールボックスオブジェクトを渡すと、テキストのフルパスに変換
on extraxctTextFullPathOfMBObject(aPath)
　　tell application "Mail"
　　　　try
　　　　　　set parentPath to container of aPath
　　　　on error
　　　　　　return
　　　　end try
　　　　
　　　　set meName to name of aPath
　　　　if aFullPath = "" then –１回目のみスラッシュを入れないで処理
　　　　　　set aFullPath to meName
　　　　else
　　　　　　–通常処理はこちら
　　　　　　set aFullPath to meName & "/" & aFullPath
　　　　end if
　　　　
　　　　extraxctTextFullPathOfMBObject(parentPath) of me –再帰呼び出し
　　end tell
end extraxctTextFullPathOfMBObject

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

*)

global aFullPath

set aFullPath to “”
tell application “Mail”
　　set aMB to properties of mailbox “ML/Apple US/ASに関係のあるもの/SyncService” –mailboxオブジェクトを作ってみた
end tell

extraxctTextFullPathOfMBObject(aMB) of me
aFullPath
–> “ML/Apple US/ASに関係のあるもの/SyncService”

–Mail.appのメールボックスオブジェクトを渡すと、テキストのフルパスに変換
on extraxctTextFullPathOfMBObject(aPath)
　　tell application “Mail”
　　　　try
　　　　　　set parentPath to container of aPath
　　　　on error
　　　　　　return
　　　　end try
　　　　
　　　　set meName to name of aPath
　　　　if aFullPath = “” then –１回目のみスラッシュを入れないで処理
　　　　　　set aFullPath to meName
　　　　else
　　　　　　–通常処理はこちら
　　　　　　set aFullPath to meName & “/” & aFullPath
　　　　end if
　　　　
　　　　extraxctTextFullPathOfMBObject(parentPath) of me –再帰呼び出し
　　end tell
end extraxctTextFullPathOfMBObject

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

set yesterdayDate to ((current date) - 1 * days)
set time of yesterdayDate to 0
set mList to {}
set mList_r to a reference to mList

set mlLocList to getMLRulesStorage() of me
tell application "Mail"
　　repeat with i in mlLocList
　　　　tell i
　　　　　　set mCount to count (every message whose date received > yesterdayDate)
　　　　end tell
　　　　if mCount > 0 then
　　　　　　set the end of mList_r to {name of i as string, mCount}
　　　　end if
　　end repeat
end tell

set bList to shellSortListDecending(mList, 2) of me
bList

–Mail.appのRuleのうち名称に「_ML」が入っているものの、保存先メールボックスを抽出
on getMLRulesStorage()
　　tell application "Mail"
　　　　set mbList to move message of every rule whose name contains "ML" and name of it does not contain "会社"
　　end tell
　　return mbList
end getMLRulesStorage

–シェルソートで入れ子のリストを昇順ソート
on shellSortListAscending(a, keyItem)
　　set n to length of a
　　set cols to {1391376, 463792, 198768, 86961, 33936, 13776, 4592, 1968, 861, 336, 112, 48, 21, 7, 3, 1}
　　repeat with h in cols
　　　　if (h ≤ (n - 1)) then
　　　　　　repeat with i from h to (n - 1)
　　　　　　　　set v to item (i + 1) of a
　　　　　　　　set j to i
　　　　　　　　repeat while (j ≥ h) and ((contents of item keyItem of item (j - h + 1) of a) > (item keyItem of v))
　　　　　　　　　　set (item (j + 1) of a) to (item (j - h + 1) of a)
　　　　　　　　　　set j to j - h
　　　　　　　　end repeat
　　　　　　　　set item (j + 1) of a to v
　　　　　　end repeat
　　　　end if
　　end repeat
　　return a
end shellSortListAscending

–シェルソートで入れ子のリストを降順ソート
on shellSortListDecending(a, keyItem)
　　set n to length of a
　　set cols to {1391376, 463792, 198768, 86961, 33936, 13776, 4592, 1968, 861, 336, 112, 48, 21, 7, 3, 1}
　　repeat with h in cols
　　　　if (h ≤ (n - 1)) then
　　　　　　repeat with i from h to (n - 1)
　　　　　　　　set v to item (i + 1) of a
　　　　　　　　set j to i
　　　　　　　　repeat while (j ≥ h) and ((contents of item keyItem of item (j - h + 1) of a) < (item keyItem of v))
　　　　　　　　　　set (item (j + 1) of a) to (item (j - h + 1) of a)
　　　　　　　　　　set j to j - h
　　　　　　　　end repeat
　　　　　　　　set item (j + 1) of a to v
　　　　　　end repeat
　　　　end if
　　end repeat
　　return a
end shellSortListDecending

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

set aMailBox to getSelectedOneMailBox() of me
tell application "Mail"
　　
　　tell aMailBox
　　　　set mList to (every message whose date sent > yesterdayDate)
　　end tell
　　
　　set sList to {}
　　repeat with i in mList
　　　　set the end of sList to date sent of i
　　end repeat
　　
　　
　　set {itemList, ssList} to detectDuplicationSimple(sList) of me
　　
　　repeat with i in itemList
　　　　set anMessage to item i of mList
　　　　tell anMessage
　　　　　　delete
　　　　end tell
　　end repeat
end tell

–リスト中の重複検出
on detectDuplicationSimple(cList)
　　copy cList to ccList
　　
　　set j to length of ccList
　　set dupList to {}
　　set itemList to {}
　　
　　repeat with i from 2 to j
　　　　set first_item to item 1 of ccList
　　　　
　　　　set ccList to rest of ccList
　　　　if first_item is in ccList then
　　　　　　set the end of dupList to first_item
　　　　　　set the end of itemList to (i - 1)
　　　　end if
　　end repeat
　　
　　return {itemList, dupList}
end detectDuplicationSimple

–Message Viewerで現在表示中のメールボックスの情報を１つのみ返す
on getSelectedOneMailBox()
　　tell application "Mail"
　　　　tell message viewer 1
　　　　　　set mbList to selected mailboxes
　　　　end tell
　　end tell
　　if length of mbList is equal to 0 then
　　　　return ""
　　end if
　　
　　set aMailBox to contents of (item 1 of mbList)
　　return aMailBox
end getSelectedOneMailBox

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

set mRes to retSelectedMessagePath() of me

–Mail.appで選択中のメッセージの実ファイルが存在するパスを取得する
on retSelectedMessagePath()
　　set lpath to POSIX path of (path to library folder from user domain)
　　set res to {}
　　tell application “Mail“
　　　　set sels to (get selection)
　　　　if (sels = {}) or ((count of sels) is not equal to 1) then
　　　　　　return false
　　　　end if
　　　　
　　　　repeat with i from 1 to count of sels
　　　　　　set p to “.mbox/Messages/“
　　　　　　set m to mailbox of item i of sels
　　　　　　set mid to id of item i of sels
　　　　　　tell m
　　　　　　　　set n to name
　　　　　　　　if (its account exists) then
　　　　　　　　　　tell its account
　　　　　　　　　　　　if (account type is not pop) then set p to “.imapmbox/Messages/“
　　　　　　　　　　　　set end of res to account directory & “/” & n & p & mid & “.emlx“
　　　　　　　　　　end tell
　　　　　　　　else
　　　　　　　　　　set c to its container
　　　　　　　　　　set p to n & p
　　　　　　　　　　repeat while c exists
　　　　　　　　　　　　set p to c’s name & “/” & p
　　　　　　　　　　　　set c to c’s container
　　　　　　　　　　end repeat
　　　　　　　　　　set end of res to lpath & “Mail/Mailboxes/” & p & mid & “.emlx“
　　　　　　　　end if
　　　　　　end tell
　　　　end repeat
　　end tell
　　set aRes to item 1 of res
　　set fPath to POSIX file aRes
　　return fPath
end retSelectedMessagePath

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

on download_path()
　　set p to (path to preferences folder from user domain ?
　　　　as Unicode text) & “com.apple.mail.plist“
　　tell application “System Events” to set f to value of ?
　　　　property list item “MailDownloadsPath” of property list file p & “/“
　　if f does not start with “~” then return f
　　set h to POSIX path of (path to home folder)
　　if (count f) < 3 then return h
　　h & f’s text 3 thru -1
end download_path

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

–> false

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

–> {mailbox “ML/Apple US/ASに関係のあるもの/Apple Help” of application “Mail”}

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

–> {move deleted messages to trash:false, account type:pop, email addresses:{”maro@XXXXXX.jp”}, empty trash on quit:true, file path:”/Users/maro/Library/Mail/POP-maro@XXX.XXX.XXX.XXX”, authentication:none, empty junk messages frequency:0, delayed message deletion interval:7, enabled:true, class:pop account, password:”Account passwords can only be set, not read.”, big message warning size:-1, full name:”Takaaki Naganoya”, uses ssl:false, empty sent messages on quit:false, name:”xxxx.jp”, port:110, empty trash frequency:0, empty junk messages on quit:true, delete mail on server:missing value, user name:”maro”, smtp server:smtp server “xxxxxxx.xxx.xx.jp” of application “Mail”, empty sent messages frequency:-1, include when getting new mail:true, server name:”XXX.XXX.XXX.XXX”, delete messages when moved from inbox:false}

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

ぴよ〜“

sendMail(aSubject, theSender, recipientAddr, bodyText) of me

–Mail.appでメール送信を行う
on sendMail(theSubject, theSender, recipientAddr, bodyText)
　　tell application “Mail“
　　　　set newMessage to make new outgoing message with properties {subject:theSubject, content:bodyText}
　　　　tell newMessage
　　　　　　set visible to true
　　　　　　set sender to theSender
　　　　　　make new to recipient at end of to recipients with properties {address:recipientAddr}
　　　　　　send
　　　　end tell
　　end tell
end sendMail

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に