A Few weeks ago someone asked me if there was a way to email data from a spreadsheet in an email using Outlook? I looked at several different ways at getting this done and realized the easiest was to write a VBA script using the shell32.dll. If you look at the script I have inserted comments and changed the font colors to try and break this down so that you can understand what is going on. This script was written so that row data could be extracted and used to email to any email client or device in simple plain text non HTML.

First thing you need to know is how to get to the Visual Basic Side of Excel, if you hit the F11 key it will open this up for you.

Now that we have this open we are going to paste the below text into the sheet:

'       Created by Eric Swain

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 SendEmail()

    Dim Email As String, Subj As String
    Dim Msg As String, URL As String
    Dim r As Integer, x As Double
    For r = 2 To 20 'data in rows 2-20
'       Get the email address
        Email = Cells(r, 3)
       
'       Message subject
        Subj = "Price Update"

'       Compose the message
        Msg = ""
        Msg = Msg & "Dear " & Cells(r, 2) & "," & vbCrLf & vbCrLf
        Msg = Msg & "Here are your current Hay prices as of: " & Cells(6, 15).Text & "." & vbCrLf
        Msg = Msg & "(Base not including Tax)" & vbCrLf
        Msg = Msg & Cells(r, 4).Text & "." & vbCrLf & vbCrLf

        Msg = Msg & "Nice Hay1" & Cells(r, 8).Text & "." & vbCrLf & vbCrLf
        Msg = Msg & "Nice Hay2" & Cells(r, 9).Text & "." & vbCrLf & vbCrLf
        Msg = Msg & "Good Hay1" & Cells(r, 10).Text & "." & vbCrLf & vbCrLf
        Msg = Msg & "Supreme Hay2" & Cells(r, 11).Text & "." & vbCrLf & vbCrLf
       
        Msg = Msg & "Please verify pricing when placing your order. All prices subject to change on availability and supplier price changes." & vbCrLf
        Msg = Msg & Cells(r, 5).Text & "." & vbCrLf & vbCrLf
        Msg = Msg & "Thank You for your patronage," & vbCrLf
        Msg = Msg & Cells(r, 12).Text & "." & vbCrLf
        Msg = Msg & "Sales Representative" & vbCrLf
        Msg = Msg & Cells(r, 13).Text & "cell" & vbCrLf
        Msg = Msg & "Some Hay Company"
       
'       Replace spaces with %20 (hex)
        Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
        Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")
               
'       Replace carriage returns with %0D%0A (hex)
        Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")        '       Create the URL
        URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

'       Execute the URL (start the email client)
        ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

'       Wait three seconds before sending keystrokes
        Application.Wait (Now + TimeValue("0:00:03"))
        Application.SendKeys "%s"
    Next r
End Sub

That's it happy coding.