Mail Archiving Service for Mountain Lion

Many moons ago, based on a friend’s script and my previous tinkering, I came up with an original AppleScript to archive my e-mail under a Personal/Year/Quarter folder hierarchy, which was designed to be activated from either a Mail.app rule or via Mail Act-On.

That was four years or so ago, and in the meantime – for whatever idiotic reason – AppleScript has mutated yet again.

So here’s a new, updated version that works in Mountain Lion:

tell application "Mail"
	set theSelection to selection
	--loop through all selected messages
	repeat with thisMessage in theSelection
		set msgDate to date received of thisMessage
		set msgMonth to month of msgDate as integer
		set msgYear to year of msgDate as integer
		set msgQuarter to ((round ((msgMonth - 1) / 3) rounding down) + 1)
		set msgAccount to name of account of mailbox of thisMessage
		set msgMailbox to name of mailbox of thisMessage
		set mboxName to "Personal/" & msgYear & "/Q" & msgQuarter
		tell account "iCloud"
			try
				set mbox to mailbox named mboxName
				get name of mbox
			on error
				make new mailbox with properties {name:mboxName}
				set mbox to mailbox named mboxName
			end try			
			set mailbox of thisMessage to mailbox named mboxName
		end tell
	end repeat
end tell

(source)

Back in 2009, Snow Leopard’s services architecture had prompted me to revise the script a bit, so at the time I dropped it into an Automator service and bound it to ^P for Mail alone, adding Growl notifications to boot:

on run {input, parameters}

  tell application "Mail"
    set theMessages to selection
    set theCount to count of selection
    if theCount = 0 then return input
    repeat with thisMessage in theMessages
      set msgDate to date received of thisMessage
      set msgMonth to month of msgDate as integer
      set msgYear to year of msgDate as integer
      set msgQuarter to ((round ((msgMonth - 1) / 3) rounding down) + 1)
      set msgAccount to name of account of mailbox of thisMessage
      set msgMailbox to name of mailbox of thisMessage
      set mboxName to "Personal/" & msgYear & "/Q" & msgQuarter
      tell account "MobileMe"
        try
          set mbox to mailbox named mboxName
          get name of mbox
        on error
          make new mailbox with properties {name:mboxName}
          set mbox to mailbox named mboxName
        end try
        -- Important sanity check due to some IMAP servers deleting messages when moved atop themselves...
        set curmbox to (get mailbox of thisMessage)
        if mbox is not curmbox then
          move thisMessage to mbox
        end if
      end tell
    end repeat
  end tell
  
  tell application "GrowlHelperApp"
    if theCount > 1 then
      set suffix to "s"
    else
      set suffix to ""
    end if
    set the theNotification to {"Mail Notification"}
    register as application "Mail" all notifications theNotification default notifications theNotification icon of application "Mail"
    notify with name (item 1 of theNotification) title "Archiving " & theCount & " message" & suffix description "to " & mboxName application name "Mail"
  end tell
  return input
end run

(source)

Of course, these days all you need is Automator. So to use this yourself, create a new service inside Automator, paste the more recent source code into the Run AppleScript box and save it with whatever name it pleases you (I used “Archive to iCloud”).

Then go into System Preferences – Keyboard, create a new key binding for Mail and enter that same name as the title for the binding.

Mail Archiving Service for Mountain Lion

See Also

Meta

Snow Leopard	My Snow Leopard experience so far	AppleScript	Growl
MailActOn 2.0.1	Automator	Mail.app	Making the Mouse Redundant
Dams and Pinkies