Created
August 2, 2021 21:17
-
-
Save samdphillips/e154f0f00de0a77c5c60ae1d6034d776 to your computer and use it in GitHub Desktop.
Archive emails from outlook
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#lang racket/base | |
(require ffi/unsafe | |
ffi/unsafe/objc | |
ffi/unsafe/nsstring | |
gregor | |
racket/match | |
racket/sequence | |
threading) | |
;; Get started by loading the Cocoa scripting bridge bundle. | |
(import-class NSBundle) | |
(define sb-bundle | |
(tell NSBundle | |
bundleWithPath: | |
#:type _NSString | |
"/System/Library/Frameworks/ScriptingBridge.framework")) | |
(unless (tell #:type _BOOL sb-bundle load) | |
(error "failed to load Cocoa scripting bridge")) | |
;; Now import the scripting bridge class and connect to the target | |
(import-class SBApplication) | |
;; osascript -e 'id of app "Microsoft Outlook"' | |
(define outlook | |
(tell SBApplication | |
applicationWithBundleIdentifier: | |
#:type _NSString "com.microsoft.Outlook")) | |
;; XXX: actually general enough for any NSArray | |
(define (in-messages msgs) | |
(define count (tell #:type _uint64 msgs count)) | |
(define (at i) | |
(tell msgs objectAtIndex: #:type _uint64 i)) | |
(sequence-map at (in-range 0 count))) | |
(match-define | |
(vector archive-folder | |
archive-path) | |
(current-command-line-arguments)) | |
(define archive-filename | |
(build-path archive-path | |
(~t (today) "yyyy'_'MM'_'dd'.mbox'"))) | |
(define the-messages | |
(~> (tell outlook defaultAccount) | |
(tell mailFolders) | |
(tell objectWithName: | |
#:type _NSString | |
archive-folder) | |
(tell messages))) | |
;; this is not quite mbox, but mbox enough | |
;; using '\r' as line ending and the dummy 'From ' line to match | |
;; older archives | |
(call-with-output-file archive-filename | |
#:exists 'replace | |
(lambda (outp) | |
(for ([msg (in-messages the-messages)]) | |
(displayln (tell #:type _NSString msg subject)) | |
(define contents (tell #:type _NSString msg source)) | |
(write-string "From ???@???\r" outp) | |
(write-string contents outp) | |
(write-string "\r" outp)))) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment