Send text in the body of the mail with Outlook Express		Index
Ron de Bruin ( Last update 20 June 2004 )
 
It is only possible with OE when you use SendKeys to press the
Send button. Also the amount of characters is limited.
 
 
Below there are two examples to send a range in the body with Outlook Express.
The first send Sheets("mysheet").Range("C1:C20") and the second one
Sheets("mysheet").Range("C1:C60").
The second sub can send more characters then the first one.
 
Example 1
 
Sub Mail_Text_in_Body()
'Example for Outlook Express
'In Excel 2002 I can use around 600-700 characters
    Dim msg As String, cell As Range
    Dim Recipient As String, Subj As String, HLink As String
    Dim Recipientcc As String, Recipientbcc As String
    Recipient = "ron@debruin.nl"
    Recipientcc = ""
    Recipientbcc = ""
    'You can use a cell value also like this
    'Recipient = Sheets("mysheet").Range("A1").Value
    Subj = "Testbodymail"
    'Subj = Sheets("mysheet").Range("A2").Value
    msg = "Dear customer" & vbNewLine & vbNewLine
    For Each cell In Sheets("mysheet").Range("C1:C20")
        msg = msg & vbNewLine & cell
    Next cell
    msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A")  
    'If you have hard returns in one of your cells you also need this line (Tip from Keepitcool)
    msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A")
    HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc & "&" & "bcc=" & Recipientbcc & "&"
    HLink = HLink & "subject=" & Subj & "&"
    HLink = HLink & "body=" & msg
 
    ActiveWorkbook.FollowHyperlink (HLink)
    Application.Wait (Now + TimeValue("0:00:03"))
    Application.SendKeys "%s"
End Sub

 

 
Example 2
 
Example 2 : copy the code below in a normal module
 
Private 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 Mail_Text_in_Body_2()
'Example for Outlook Express with API call
'In Excel 2002 I can use around 1800 characters
    Dim msg As String, URL As String
    Dim Recipient As String, Subj As String
    Dim Recipientcc As String, Recipientbcc As String
    Dim cell As Range
    Recipient = "ron@debruin.nl"
    Recipientcc = ""
    Recipientbcc = ""
    'You can use a cell value also like this
    'Recipient = Sheets("mysheet").Range("A1").Value
    Subj = "Testbodymail"
    'Subj = Sheets("mysheet").Range("A2").Value
    msg = "Dear customer" & vbNewLine & vbNewLine
    For Each cell In Sheets("mysheet").Range("C1:C60")
        msg = msg & vbNewLine & cell
    Next cell
    msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A")   
    'If you have hard returns in one of your cells you also need this line (Tip from Keepitcool)
    msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A")
    URL = "mailto:" & Recipient & "?cc=" & Recipientcc & "&bcc=" & Recipientbcc _
        & "&subject=" & Subj & "&body=" & msg
    ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus
    Application.Wait (Now + TimeValue("0:00:03"))
    Application.SendKeys "%s"
End Sub
 
 
 
 
Send personalized email (with Outlook Express)
 
See John Walkenbach his website.
http://www.j-walk.com/ss/excel/tips/tip86.htm

 

This sub is doing the same as John's Example (see Webpage)

Only I use FollowHyperlink in the code.

See the website for more information.

 

Sub SendEmail2()
    ' Ron de Bruin
    For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "*@*" Then
            Recipient = cell.Value
            Subj = "Your Annual Bonus"            
            Msg = "Dear " & cell.Offset(0, -1).Value & "%0A"
            Msg = Msg & "%0A" & "I am pleased to inform you that your annual bonus is "
            Msg = Msg & cell.Offset(0, 1).Value & "%0A"
            Msg = Msg & "%0A" & "William Rose"
            Msg = Msg & "%0A" & "President"
            HLink = "mailto:" & Recipient & "?"
            HLink = HLink & "subject=" & Subj & "&"
            HLink = HLink & "body=" & Msg
            ActiveWorkbook.FollowHyperlink (HLink)
            Application.Wait (Now + TimeValue("0:00:02"))
            SendKeys "%s", True
        End If
    Next
End Sub