Opening a Draft E-mail or an e-mail in edit mode.

[Lyle Fairfield]

I was prompted to think about this by a couple of MLH's recent posts.
Whether this is what he !!!!really!!!! wanted, I don't know.

This code is supposed to open an e-mail in edit mode, although I have
called it "draft". It's pretty simple. It just creates an .eml file, in
eml format, and then calls ShellExecute to open the file (I tried
Application.FollowHyperlink first; that works but results in two
warning messages on my machine.) Some e-mail programs when set as the
default will also make themselves the default opener of .eml files so
on my machine this opens in Thunderbird and I can edit, save as a
draft, send or delete it.

Private Declare Function ShellExecute& Lib "shell32.dll" _
Alias "ShellExecuteA" _
( _
ByVal Window&, _
ByVal Operation$, _
ByVal File$, _
ByVal Parameters$, _
ByVal Directory$, _
ByVal Show&)

Public Sub Draft( _
ByVal from$, _
ByVal recipients$, _
ByVal subject$, _
ByVal body$, _
Optional ByVal cc$, _
Optional ByVal bcc$, _
Optional ByVal priority&)

Dim buffer$
Dim filenumber%
Dim filename$
Dim path$

On Error GoTo DraftErr:

buffer = "From:" & Chr(34) & from & Chr(34)
buffer = buffer & vbNewLine & "To:" & Chr(34) & recipients & Chr(34)
If Len(cc) 0 Then _
buffer = buffer & vbNewLine & "CC:" & Chr(34) & cc & Chr(34)
If Len(bcc) 0 Then _
buffer = buffer & vbNewLine & "BCC:" & Chr(34) & bcc & Chr(34)
buffer = buffer & vbNewLine & "Subject:" & Chr(34) & subject & Chr(34)
If priority < 1 Or priority 3 Then _
priority = 3
buffer = buffer & vbNewLine & "X_priority:" & priority
buffer = buffer & vbNewLine & "X_Unsent: 1"
buffer = buffer & vbNewLine
buffer = buffer & vbNewLine & body

path = Environ("temp")
filename = path & "\temp.eml"
' I doubt this line is necessary
' in VBA but it may be
' in languages where "\"
' is a literal precursor
filename = Replace(filename, "\", "/")

On Error Resume Next
Kill filename
On Error GoTo DraftErr:

filenumber = FreeFile()
Open filename For Binary As #filenumber
Put #filenumber, , buffer
Close #filenumber

ShellExecute 0, "Open", "file://" & filename, "", "", 0

DraftExit:
Close
Exit Sub

DraftErr:
With Err
MsgBox "Error Number " & .Number & vbNewLine & .Description,
vbCritical, "Draft Creation Failed"
End With
Resume DraftExit
End Sub

Sub testDraft()
Draft "so*****@some.domain", "so*********@someother.domain",
"Draft", "This is a test."
End Sub