Follow up about using VBA to send e-mail

Question

This is a follow up to several messages about using VBA to send e-mail.

Most suggestions use either Outlook, CDO, or MAPI:

Set appOL = CreateObject("Outlook.Application") 

Set msgOne = CreateObject("CDO.Message") 

Set mapi_session = New MSMAPI.MAPISession

But apparently Outlook will require me to change our workgroup security settings, and CDO and MAPI will require me to add a DLL or something.

I'm trying to use Excel to organize group assignments at work and I can't modify the other people's computers in any way.

Is there a simpler way to send e-mails from an Excel macro?
All I need is a block of text in the body of the message with no attachments.

I've been plowing through Google, MSDN & StackOverflow all week and I'm stuck on a slow boat to nowhere.

Siddharth Rout Siddharth Rout · Accepted Answer · 2012-04-28T22:19:48

Building up on what Marc mentioned, Here is a tried and tested version.

Option Explicit

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Sub SendMail()
    Dim objMail As String
    Dim oMailSubj, oMailTo, oMailBody As String

    On Error GoTo Whoa

    oMailSubj = "YOUR SUBJECT GOES HERE"
    oMailTo = "[email protected]"
    oMailBody = "BLAH BLAH!!!!"
    objMail = "mailto:" & oMailTo & "?subject=" & oMailSubj & "&body=" & oMailBody

    ShellExecute 0, vbNullString, objMail, vbNullString, vbNullString, vbNormalFocus

    Application.Wait (Now + TimeValue("0:00:03"))
    Application.SendKeys "%s"

    Exit Sub
Whoa:
    MsgBox Err.Description
End Sub

FOLLOWUP

Thanks for the info. I had already ruled out ShellExecute because it limits the entire parameter string to 250 char and I need about 2000 for the message. But it's looking like SE is the only option that will actually work in my case. – Humanoid1000 7 hours ago

Here is the "Horrible (I love the way JFC says that!!!)" way I mentioned below in the comments which works beautifully :) BTW I have only Outlook as my default client so I have tested it with that.

CODE

Option Explicit

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub SendMail()
    Dim objMail As String
    Dim oMailSubj As String, oMailTo As String
    Dim i As Long
    Dim objDoc As Object, objSel As Object, objOutlook As Object
    Dim MyData As String, strData() As String

    On Error GoTo Whoa

    '~~> Open the txt file which has the body text and read it in one go
    Open "C:\Users\Siddharth Rout\Desktop\Sample.Txt" For Binary As #1
    MyData = Space$(LOF(1))
    Get #1, , MyData
    Close #1
    strData() = Split(MyData, vbCrLf)

    Sleep 300

    oMailSubj = "YOUR SUBJECT GOES HERE"
    oMailTo = "[email protected]"
    objMail = "mailto:" & oMailTo & "?subject=" & oMailSubj

    ShellExecute 0, vbNullString, objMail, vbNullString, vbNullString, vbNormalFocus

    Sleep 300

    Set objOutlook = GetObject(, "Outlook.Application")
    '~~> Get a Word.Selection from the open Outlook item
    Set objDoc = objOutlook.ActiveInspector.WordEditor
    Set objSel = objDoc.Windows(1).Selection

    objDoc.Activate

    Sleep 300

    For i = LBound(strData) To UBound(strData)
        objSel.TypeText strData(i)
        objSel.TypeText vbNewLine
    Next i

    Set objDoc = Nothing
    Set objSel = Nothing

    '~~> Uncomment the below to actually send the email
    'Application.Wait (Now + TimeValue("0:00:03"))
    'Application.SendKeys "%s"

    Exit Sub
Whoa:
    MsgBox Err.Description
End Sub

SNAPSHOT

Text File which has the message

enter image description here

Email just before it is sent

enter image description here

Follow up about using VBA to send e-mail

3 Answers