w32-send-mapi.el 0.1

[Mathias Dahl]

;;; w32-send-mapi.el --- send e-mail messages using MAPI

;; Copyright (C) 2005 Mathias Dahl

;; Version: 0.1
;; Keywords: w32, e-mail, vbscript
;; Author: Mathias Dahl <address@hidden>
;; Maintainer: Mathias Dahl
;; URL: http://groups.google.com/groups?q=w32-send-mapi

;; This file is not part of GNU Emacs.

;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
;; License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Even though I have to use MS Outlook at work I like writing my
;; e-mails in a normal *mail* buffer in Emacs. I usually copy and
;; paste the text from there into the mail. One day I got tired of
;; that and hacked together this little package.
;;
;; It uses MAPI to send a message by fetching information from a
;; normal *mail* buffer to build some vbscript code that is executed
;; by wscript.exe.
;;

;;; Prerequistites:

;;
;; * MAPI must be working on your machine
;;
;; * It needs wscript.exe to be able to execute the vbscript doing the
;;   actual work.
;;

;;; Usage:

;; Open up a mail buffer (C-x m).
;; Add one or more recipients, a subject and a body.
;; Execute it: M-x w32-send-mapi.

;;; History:

;; Version 0.1, 2005-03-07
;; * First release.

;;; Bugs:

;; Probably a bunch of them.

;;; Todo:

;; Find a way to make the code generation part look cleaner. Maybe
;; using `format'.

(defun w32-send-mapi-mail-header-recipients ()
  "Fetch a list of strings containing the recipients from the
  mail header"
  (save-excursion
    (goto-char (point-min))
    (split-string
     (cdr (assoc 'to (mail-header-extract-no-properties))) "[,;]")))

(defun w32-send-mapi-mail-header-subject ()
  "Fetch the subject from the mail header"
  (save-excursion
    (goto-char (point-min))
    (cdr (assoc 'subject (mail-header-extract-no-properties)))))

(defun w32-send-mapi-generate-recipients-code (to-list)
  "Using a list of recipients, create the vbwscript code
  necessary to add them."
  (let ((count 0)
        (to-list-code nil))
    (while to-list
      (setq to-list-code
            (concat to-list-code
                    "oMess.RecipType = mapToList\n"
                    "oMess.RecipIndex = " (int-to-string count) "\n"
                    "oMess.RecipDisplayName = Trim(\""
                    (car to-list) "\")\n"))
      (setq count (1+ count))
      (setq to-list (cdr to-list)))
    to-list-code))

(defun w32-send-mapi ()
  "Send a mail using MAPI using the information in a normal
  *mail* buffer. Requires wscript.exe to work."
  (interactive)
  (save-excursion
    (let ((script-file-name (expand-file-name "~/w32-send-mapi.vbs"))
          to-list-code
          to-list
          subject-text
          body-text
          (case-fold-search t)
          (buf (get-buffer-create "*w32-send-mapi*")))
      ;; Get recipients and subject
      (setq to-list (w32-send-mapi-mail-header-recipients))
      (setq subject-text (w32-send-mapi-mail-header-subject))
      ;; Body:
      (goto-char (point-min))
      (re-search-forward (concat "^" (regexp-quote
                                      "--text follows this line--")))
      (skip-chars-forward "\n")
      (setq body-text (buffer-substring-no-properties
                       (point) (point-max)))
      (set-buffer buf)
      (erase-buffer)
      (insert body-text)
      (goto-char (point-min))
      ;; Escape all quotation characters
      (replace-string "\"" "\"\"")
      (goto-char (point-min))
      ;; Sligthly ugly way to handle newlines (seems to work well
      ;; though)
      (replace-string "\n" "\" & Chr(13) & Chr(10) & _ \n \"")
      (setq body-text (buffer-substring-no-properties
                       (point-min) (point-max)))
      (erase-buffer)
      ;; Generation of main vbscript code starts here
      (insert
       "
Option Explicit
Dim oMess
Dim oSess
Sub Main
")
      ;; Constant for main recipient

      (insert
       "
  Const mapToList = 1
")

      ;; Constant for CC
      (insert
       "
  Const mapCcList = 2
")

      ;; Constant for BCC
      (insert
       "
  Const mapBccList = 3
  On Error Resume Next
")
      ;; Try to create MAPI session
      (insert
       "
  Set oSess = CreateObject(\"MSMAPI.MAPISession\")
  If Err.Number <> 0 Then
    MsgBox \"Could not find MAPI. Exiting...\"
    Exit Sub
  End If
  Set oMess = CreateObject(\"MSMAPI.MAPIMessages\")
  On Error GoTo 0
")

      ;; We do not care about new mails right now
      (insert
       "
  oSess.DownLoadMail = False
")

      ;; Log on MAPI
      (insert
       "
  oSess.SignOn
")

      ;; Set session ID for the message, using our active session

      (insert
       "
  oMess.SessionID = oSess.SessionID
")

      ;; Start compose message
      (insert
       "
  oMess.Compose
")

      ;; Subject text inserted here
      (insert
       "
  oMess.MsgSubject = \"" subject-text " \"
")

      ;; Body text inserted here
      (insert
       "
  oMess.MsgNoteText = \"" body-text "\"
")

      ;; For now, just add a normal recipient. For other types of
      ;; recipients, use for exampe mapCcList to add CC
      ;; recipients. Increase index for each recipient.

      ;; Note that you do not need to add a recipient at all for the
      ;; MAPI call to work.

      ;; Recipient names inserted here
      ;;
      ;; Limitataion:
      ;;
      ;; Note that we make use of only the name, not the e-mail
      ;; address. This means we rely on the MUA to expand the names to
      ;; valid e-mail addresses before the mail is sent.

      (insert (w32-send-mapi-generate-recipients-code to-list))

      ;; Catch error which is thrown by the Send method if user
      ;; cancels mail

      (insert
       "
  On Error Resume Next
")

      ;; Open up the mail application
      (insert
       "
  oMess.Send True
  If Err.Number <> 0 Then
    MsgBox \"Could not send message. Reason: \" & Err.Description
    Exit Sub
  End If
  On Error GoTo 0
  oSess.SignOff
End Sub
")
      ;; Execute main Sub
      (insert
       "
Main
")
      ;; Clean up
      (insert
       "
Set oSess = Nothing
Set oMess = Nothing
")
      ;; Write the script to a file
      (write-file script-file-name)
      (kill-buffer buf)
      (setq script-file-name
            (substitute ?\\ ?/ script-file-name))
      ;; Execute script
      (w32-shell-execute nil "wscript.exe"
                         script-file-name))))

(provide 'w32-send-mapi)

;;; w32-send-mapi.el ends here