Copy/Paste to email

I use the code below (which someone out there kindly sent to me) to put a
range into an email message.
The problem is that I have to "paste" into the body of the email.
Can someone supply code that does this automatically,
"Public Sub SendEMailByURL()
Dim vURL As String
Dim vEmail As String
Dim vSubj As String
Dim vMsg As String
Dim vTitleEmail As String
Dim i As Long
Dim vShell
'Copy range selection to paste
Range("a8:p18").Copy
'Email data
vEmail = "[email protected]"
vSubj = "Raukawa"
vMsg = " "
vTitleEmail = vSubj
'Spaces to hexdecimal
vSubj = Application.WorksheetFunction.Substitute(vSubj, " ", "%20")
vMsg = Application.WorksheetFunction.Substitute(vMsg, " ", "%20")
'Carriage Returns to hexdecimal
vMsg = Application.WorksheetFunction.Substitute(vMsg, vbCrLf, "%0D%0A")
vURL = "mailto:" & vEmail & "?subject=" & vSubj & "&body=" & vMsg
'Shell the Windows Start
vShell = Shell(Left("Start " & vURL, 460), vbHide)
'Wait window email before sending keystrokes
WaitEmail:
On Error Resume Next
i = i + 1
Application.Wait (Now + TimeValue("0:00:01"))
AppActivate vTitleEmail 'Verify your title email
If Err.Number <> 0 And i < 30 Then GoTo WaitEmail
Application.SendKeys "{TAB}{TAB}{TAB}{TAB}~^v"
Application.Wait (Now + TimeValue("0:00:01"))
End Sub"

Barry

hi,
see this web site.
http://www.rondebruin.nl/sendmail.htm
ron knows a thing or 2 about emailing from xl.
good luck.

>-----Original Message-----
>I use the code below (which someone out there kindly sent
to me) to put a
>range into an email message.
>The problem is that I have to "paste" into the body of
the email.
>Can someone supply code that does this automatically,
>"Public Sub SendEMailByURL()
> Dim vURL As String
> Dim vEmail As String
> Dim vSubj As String
> Dim vMsg As String
> Dim vTitleEmail As String
> Dim i As Long
> Dim vShell
> 'Copy range selection to paste
>Range("a8:p18").Copy
> 'Email data
> vEmail = "[email protected]"
> vSubj = "Raukawa"
> vMsg = " "
> vTitleEmail = vSubj
> 'Spaces to hexdecimal
> vSubj = Application.WorksheetFunction.Substitute
(vSubj, " ", "%20")
> vMsg = Application.WorksheetFunction.Substitute
(vMsg, " ", "%20")
> 'Carriage Returns to hexdecimal
> vMsg = Application.WorksheetFunction.Substitute(vMsg,
vbCrLf, "%0D%0A")
> vURL = "mailto:" & vEmail & "?subject=" & vSubj
& "&body=" & vMsg
> 'Shell the Windows Start
> vShell = Shell(Left("Start " & vURL, 460), vbHide)
> 'Wait window email before sending keystrokes
>WaitEmail:
> On Error Resume Next
> i = i + 1
> Application.Wait (Now + TimeValue("0:00:01"))
> AppActivate vTitleEmail 'Verify your title email
> If Err.Number <> 0 And i < 30 Then GoTo WaitEmail
> Application.SendKeys "{TAB}{TAB}{TAB}{TAB}~^v"
> Application.Wait (Now + TimeValue("0:00:01"))
> End Sub"
>
>Barry
>
>
>.
>