Download
(require 'message)
(defvar w32-send-mapi-vbscript-template "
Option Explicit
Dim oMess
Dim oSess
Sub Main
' To make generated code smaller and (probably) slightly faster
Dim vbCrLf
vbCrLf = Chr(13) & Chr(10)
' Constant for main recipient
Const mapToList = 1
' Constant for CC
Const mapCcList = 2
' Constant for BCC
Const mapBccList = 3
On Error Resume Next
' Try to create MAPI session
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
oSess.DownLoadMail = False
' Logon MAPI
oSess.SignOn
' Set session ID for the message, using our active session
oMess.SessionID = oSess.SessionID
' Start composing message
oMess.Compose
' Subject
oMess.MsgSubject = \"%s\"
' Body
oMess.MsgNoteText = \"%s\"
' 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.
' Generated recipient-code inserted here:
%s
' Catch error which is thrown by the Send method if user
' cancels mail
On Error Resume Next
' Open up the mail application
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
Main
' Clean up
Set oSess = Nothing
Set oMess = Nothing
"
"VBScript code template")
(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 vbscript code
necessary to add them."
(let ((count 0)
(to-list-code nil))
(if (stringp to-list)
(setq to-list (list to-list)))
(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 (recipients subject body)
"Create MAPI message.
RECIPIENTS is a string of one recipient or a list of strings with
recipients. SUBJECT is the subject of the message and BODY the
message body."
(let ((buf (get-buffer-create "*w32-send-mapi*"))
(script-file-name (expand-file-name "~/w32-send-mapi.vbs")))
(set-buffer buf)
(erase-buffer)
(insert (format w32-send-mapi-vbscript-template subject
(with-temp-buffer
(insert body)
(goto-char (point-min))
(replace-string "\"" "\"\"")
(goto-char (point-min))
(replace-string "\n" "\" & vbCrLf & _ \n \"")
(buffer-substring-no-properties
(point-min) (point-max)))
(if recipients
(w32-send-mapi-generate-recipients-code recipients)
"' No recipients")))
(write-file script-file-name)
(kill-buffer buf)
(setq script-file-name
(substitute ?\\ ?/ script-file-name))
(w32-shell-execute nil "wscript.exe" script-file-name)))
(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))
(setq to-list (w32-send-mapi-mail-header-recipients))
(setq subject-text (w32-send-mapi-mail-header-subject))
(goto-char (point-min))
(re-search-forward (concat "^" (regexp-quote
mail-header-separator)))
(skip-chars-forward "\n")
(setq body-text (buffer-substring-no-properties
(point) (point-max)))
(w32-send-mapi-send to-list subject-text body-text))))
(defun w32-send-mapi-send-region (beg end recipients subject)
"Send region via MAPI."
(interactive "r\nsRecipients (separate with comma or semicolon): \nsSubject: ")
(w32-send-mapi-send (split-string recipients "[,;]")
subject
(buffer-substring-no-properties beg end)))
(provide 'w32-send-mapi)