Oops.
The file used for my first tests was in fact an emlx one whose name extension was changed to eml.
Here is a script doing the job.
on run
my germaine()
end run
on germaine()
set oldErrVersion to false
set path2app to path to application "Mail"
set ImportFolderName_loc to localized string "ImportFolderName" from table "Startup" in bundle (path2app as «class furl»)
set inputFolder to (path to desktop as text) & "Emailtrichter:"
do shell script "/bin/mkdir -p " & quoted form of (POSIX path of inputFolder)
set attachmentsFolder to (path to desktop as text) & "Emailtrichter:"
do shell script "/bin/mkdir -p " & quoted form of (POSIX path of attachmentsFolder)
set reportName to "Report_tropeR.txt"
set reportPath to (path to desktop as text) & reportName
tell application "System Events"
if exists disk item reportPath then delete disk item reportPath
end tell
-- Verarbeiten der Mail in Apple Mail
tell application "Mail"
if exists mailbox ImportFolderName_loc then delete mailbox ImportFolderName_loc
--Importieren in Mail
import Mail mailbox at file inputFolder
set mbx to mailbox ImportFolderName_loc
repeat with i from 1 to 50
tell me to delay 0.1
if (count messages of mbx) > 0 then exit repeat
end repeat
if i < 50 then
# We got a message
set aMessage to first message of mbx
else
repeat with i from 1 to 50
tell me to delay 0.1
set cntBox to count mailbox of mbx
if cntBox > 0 then exit repeat
end repeat
if i = 50 then error "No message imported !"
set newBox to mailbox 1 of mbx
repeat with i from 1 to 50
tell me to delay 0.1
if (count messages of newBox) > 0 then exit repeat
end repeat
if i = 50 then error "No message imported !"
set aMessage to first message of newBox
end if
tell aMessage
set senderName to extract name from its sender
set mailSubject to subject
set mailDate to date received
end tell
set dateStamp to my buildStampFrom(mailDate)
my exportAsPDF(aMessage, inputFolder, mailSubject & dateStamp & ".pdf")
-- set the sub folder for the attachments to the name of its sender
-- All future attachments from this sender will the be put here.
# Of course an other choice may be done !
set attachmentsSubFolder to attachmentsFolder & senderName
try # Useful for some messages received thru iCloud
# Save attachment files if there are some.
set theAttachments to aMessage's mail attachments
-- log result
if theAttachments is not {} then
# Create the destination folder if it doesn't exist.
do shell script "/bin/mkdir -p " & quoted form of (POSIX path of attachmentsSubFolder)
repeat with theAttachment in theAttachments --aMessage's mail attachments
try
set attachmentName to name of theAttachment
tell application "System Events"
# If there is a file with the same name, insert the date & time of the mail in the new file name
if exists disk item (attachmentsSubFolder & ":" & attachmentName) then
if attachmentName contains "." then
set nameAsList to my decoupe(attachmentName, ".")
set attachmentName to my recolle(items 1 thru -2 of nameAsList, ".") & dateStamp & "." & item -1 of nameAsList
else
set attachmentName to attachmentName & dateStamp
end if
end if
end tell
save theAttachment in file (attachmentsSubFolder & ":" & attachmentName)
end try
end repeat
end if
on error
tell aMessage
set itsSource to its source
end tell
set theFilenames to {}
set aList to rest of my decoupe(itsSource, "filename=") -- Filenames embedding space characters are enclosed in quotes. Sometimes the paragraph ends with a semi-colon, sometimes it doesn't
repeat with aName in aList
set aName to paragraph 1 of aName
if aName ends with ";" then set aName to rich text 1 thru -2 of aName
set end of theFilenames to aName
end repeat
set theFilenames to my recolle(theFilenames, tab)
if oldErrVersion then
tell aMessage
set itsID to its id
tell its mailbox
set itsAccount to name of its account
set itsBox to its name
# better with a loop building the full box hierarchy
end tell
end tell
set messageDescriptor to "message id " & itsID & " of mailbox \"" & itsBox & "\" of account \"" & itsAccount & "\""
else
try
aMessage as rich text # Always issue an error!
on error errMsg number errNbr
(*Impossible de convertir «class mssg» id 100683 of «class mbxp» "INBOX" of «class mact» "iCloud" of application "Mail" en type text.*)
set messageDescriptor to my recolle(rest of my decoupe(errMsg, "«"), "«")
set messageDescriptor to item 1 of my decoupe(messageDescriptor, " of application")
set messageDescriptor to my remplace(messageDescriptor, "class mssg»", "message")
set messageDescriptor to my remplace(messageDescriptor, "«class mbxp»", "mailbox")
set messageDescriptor to my remplace(messageDescriptor, "«class mact»", "account")
end try
end if
my writeTo(reportPath, mailSubject & tab & dateStamp & tab & messageDescriptor & tab & theFilenames & linefeed, rich text, true)
end try
end tell # Mail
end germaine
#=====
on exportAsPDF(thisMessage, FolderPath, pdfName)
# CAUTION : FolderPath ends with a colon
set nbTry to 20
if pdfName contains ":" then set pdfName to my remplace(pdfName, ":", "-")
set posixFolderPath to POSIX path of FolderPath
set pdfPath to (FolderPath & pdfName)
tell application "System Events"
if exists disk item pdfPath then
delete disk item pdfPath # mainly useful during tests
delay 0.2
end if
end tell
tell application "Mail"
open thisMessage
delay 0.5
set windowName to name of window 1
end tell
# Code borrowed to Nigel Garvey (http://macscripter.net/viewtopic.php?id=41654)
tell application "System Events"
tell process "Mail"
set frontmost to true
set {mt, mi} to {3, 18}
tell menu bar 1
-- log (get name of menu bar items) (*Apple, Mail, Fichier, Édition, Présentation, Historique, Signets, Développement, Fenêtre, Aide*)
-- log (get name of menu bar item mt) (*Fichier*)
tell menu bar item mt to tell menu 1
-- log (get name of menu items) (*Nouveau message, Nouvelle fenêtre de visualisation, Ouvrir le Message, missing value, Fermer la fenêtre, Fermer toutes les fenêtres, Fermer l'onglet, Enregistrer, Enregistrer sous., Enregistrer comme modèle., missing value, Joindre des fichiers., Enregistrer les pièces jointes., Coup d'œil sur les pièces jointes., missing value, Importer des boîtes aux lettres., missing value, Exporter au format PDF., missing value, Imprimer.*)
set theItem to first menu item whose name contains "PDF"
--> (*menu item Exporter au format PDF. of menu Fichier of menu bar item Fichier of menu bar 1 of application process Mail*)
repeat with ii from 1 to nbTry
if (enabled of theItem) then exit repeat
delay 0.2
end repeat
end tell # menu bar item mt
end tell # menu bar 1
-- log ii
click theItem (*Exporter au format PDF.*)
if ii < nbTry then
repeat until exists sheet 1 of window 1
delay 0.02
end repeat
tell sheet 1 of window 1
-- log (get position of text fields) (*910, 118, 910, 148*)
set value of text field 1 to pdfName
end tell
keystroke "g" using {command down, shift down}
repeat until exists sheet 1 of sheet 1 of window 1
delay 0.02
end repeat
tell sheet 1 of sheet 1 of window 1
set value of text field 1 to posixFolderPath
-- log (get name of buttons) (*Aller, Annuler*)
click button 1
end tell
tell sheet 1 of window 1
-- log (get name of buttons) (*Enregistrer, Nouveau dossier, Annuler*)
click button 1
end tell
end if # ii < nbTry
end tell # process
if ii < nbTry then
set oldSize to -1
repeat
try
if (size of disk item pdfPath) = oldSize then exit repeat
set oldSize to size of disk item pdfPath
end try
delay 0.2
end repeat
end if # ii < nbTry
end tell # "System Events"
tell application "Mail" to close window windowName
end exportAsPDF
#=====
on buildStampFrom(aDate)
tell aDate
return space & (((its year) * 10000 + (its month) * 100 + (its day)) as text) & "_" & text 2 thru -1 of ((1000000 + (its hours) * 10000 + (its minutes) * 100 + (its seconds)) as text)
end tell
end buildStampFrom
#=====
on recolle(l, d)
local oTids, t
set {oTids, AppleScript's text item delimiters} to {AppleScript's text item delimiters, d}
set t to l as text
set AppleScript's text item delimiters to oTids
return t
end recolle
#===== replaces every occurences of d1 by d2 in the text t
on remplace(t, d1, d2)
local oTids, l
set {oTids, AppleScript's text item delimiters} to {AppleScript's text item delimiters, d1}
set l to text items of t
set AppleScript's text item delimiters to d2
set t to l as text
set AppleScript's text item delimiters to oTids
return t
end remplace
#=====
on decoupe(t, d)
local oTids, l
set {oTids, AppleScript's text item delimiters} to {AppleScript's text item delimiters, d}
set l to text items of t
set AppleScript's text item delimiters to oTids
return l
end decoupe
#===== Handler borrowed from Regulus6633 - http://macscripter.net/viewtopic.php?id=36861
on writeTo(targetFile, theData, dataType, apendData)
-- targetFile is the path to the file you want to write
-- theData is the data you want in the file.
-- dataType is the data type of theData and it can be text, list, record etc.
-- apendData is true to append theData to the end of the current contents of the file or false to overwrite it
try
set targetFile to targetFile as «class furl»
set openFile to open for access targetFile with write permission
if not apendData then set eof of openFile to 0
write theData to openFile starting at eof as dataType
close access openFile
return true
on error errMsg number errNbr
-- log "errNbr #" & errNbr & ", " & errMsg
try
close access file targetFile
end try
return false
end try
end writeTo
#=====
I’m not fully satisfied because :
(1) Some messages received in my iCloud account (in fact I got that with every IMAP account) aren’t correctly treated.The script issue an error when it try to get the list of attachments. In such case, the script create a text file reporting some infos about the message including the names of attached files.
(2) I don’t understand why but if I try to run the script two times, it fails at second execution. I’m forced to restart Mail to get it working again.
I tried to get rid of that with the three loops testing the availability of the imported message but no luck. they don’t solve the problem.
Maybe somebody will give a tip curing that.
Yvan KOENIG running El Capitan 10.11.2 in French (VALLAURIS, France) jeudi 31 décembre 2015 15:58:59