Download
(defvar message-outlook-script-start "
Set objOutlk = createobject(\"Outlook.Application\")
Dim objOutlk 'Outlook
Dim objMail 'Email item
Dim strMsg
Const olMailItem = 0
'Create a new message
Set objOutlk = createobject(\"Outlook.Application\")
Set objMail = objOutlk.createitem(olMailItem)
"
"vbs script start for outlook mail message"
)
(defvar message-outlook-script-stop "
objMail.%s 'Use this To display before sending, otherwise call objMail.Send to send without reviewing
'Clean up
Set objMail = nothing
Set objOutlk = nothing
"
"vbs script stop for outlook mail message"
)
(defcustom message-outlook-display-instead-of-send 't
"If non-nil, messages are displayed instead of sent through outlook. Many scripts are disabled from sending programatically because of email viruses."
:group 'message-sending)
(defun message-send-mail-quote-vbs (body &optional file)
"Quotes VBS send-mail"
(with-temp-buffer
(insert body)
(goto-char (point-min))
(replace-string "\"" "\"\"")
(goto-char (point-min))
(replace-string "\n" "\" & vbCrLf & _ \n \"")
(when file
(goto-char (point-min))
(while (re-search-forward "/" nil t)
(replace-match "\\" nil 't))
)
(buffer-substring-no-properties
(point-min) (point-max)))
)
(defun message-send-mail-with-outlook ()
"Create specified outlook message"
(let (
(s-start message-outlook-script-start)
(s-end (format message-outlook-script-stop (if message-outlook-display-instead-of-send "display" "Send")))
(to (message-fetch-field "To"))
(bcc (message-fetch-field "Bcc"))
(cc (message-fetch-field "Cc"))
(subject (message-fetch-field "Subject"))
(importance (message-fetch-field "Importance"))
field
value
(msg "")
(buf (buffer-substring (point-min) (point-max)))
(vbs (make-temp-file "message-outlook" nil ".vbs"))
)
(with-temp-buffer
(insert buf)
(run-hooks 'message-send-mail-hook)
(when to
(setq msg (concat msg "objMail.To = \""
(message-send-mail-quote-vbs to) "\"\n"))
(message-remove-header "To")
)
(when bcc
(setq msg (concat msg "objMail.Bcc = \""
(message-send-mail-quote-vbs bcc) "\"\n"))
(message-remove-header "Bcc")
)
(when cc
(setq msg (concat msg "objMail.Cc = \""
(message-send-mail-quote-vbs cc) "\"\n"))
(message-remove-header "Cc")
)
(when subject
(setq msg (concat msg "objMail.Subject = \""
(message-send-mail-quote-vbs subject) "\"\n"))
(message-remove-header "Subject")
)
(when (and importance (and (string= importance "high")))
(setq msg (concat msg "objMail.Importance = 2\n"))
(message-remove-header "Importance")
)
(when nil
(message-remove-header "From")
(save-excursion
(save-restriction
(message-narrow-to-headers-or-head)
(goto-char (point-min))
(while (re-search-forward "^\\(.+\\):" nil t)
(setq field (match-string 1))
(setq value (message-fetch-field field))
(message-remove-header field)
(when value
(setq msg (concat msg "Dim property As ItemProperty\nSet property =objMail.ItemProperties.Add(\""
(message-send-mail-quote-vbs field) "\")\nproperty.value=\"" "\"\nobjMail.Save\n"))
(goto-char (point-min))
)
)
)
)
)
(goto-char (point-min))
(while (re-search-forward "<#\\(?:part\\|external\\) \\(.\\|\n\\)*?\\<\\(?:file\\)?name=\"\\(.*\\)\"[ \t\n]*disposition=attachment>" nil t)
(setq value (match-string 2))
(replace-match "")
(delete-region (point) (progn (re-search-forward "<#/\\(?:part\\|external\\)>[ \t\n]*" nil t) (point)))
(setq msg (concat msg "objMail.attachments.add(\"" (message-send-mail-quote-vbs value 't) "\")\n"))
)
(goto-char (point-min))
(delete-region (point-min) (progn (search-forward "--text follows this line--")))
(setq value (buffer-substring (point-min) (point-max)))
(setq msg (concat msg "objMail.body = \"" (message-send-mail-quote-vbs value 't) "\"\n"))
(setq msg (concat s-start msg s-end))
(with-temp-file vbs
(insert msg)
)
(shell-command-to-string (concat "wscript.exe " vbs))
(delete-file vbs)
)
)
)
(setq message-send-mail-function 'message-send-mail-with-outlook)
(provide 'message-outlook)