I have borrowed this code from a web site which I can not remember at the
minute. I have four problems with it.


1 A messages pops up informing me that another program is trying to send
email. I do not want this message to pop up.

2 Sometimes the email I am sending ends up in the Outbox with it not being
sent.

3. After selecting and running the macro several times and then bringing up
Task Manager there seems to be many instances of OUTLOOK running.

4 It seems to send two messages for every selection I made instead of the
one email which I want.

Any ideas on how to overcome these problems would be greatly appreciated.




'Using HTML in Message Body


Sub RangeInBody()

Dim olApp As Outlook.Application
Dim olMail As MailItem

Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)

With olMail
.To = "
.Subject = "This is the Subject"
.HTMLBody = RangetoHTML(Selection)
.Send
End With


Set olMail = Nothing
Set olApp = Nothing
End Sub






Function RangetoHTML(Rng As Range)

Dim wb As Workbook
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim i As Long
Dim Rng2 As Range
Dim DelCol1 As String
Dim DelCol2 As String

Randomize

TempFile = Rng.Parent.Parent.Path & "\TmpHTML" & Int(Rnd() * 10) &
".htm"

'Copy the sheet to a new workbook and copy the cells to avoid the
'255 character limit when copying sheets
Rng.Parent.Copy
Rng.Parent.Cells.Copy ActiveSheet.Cells

Set wb = ActiveWorkbook
Set Rng2 = wb.Sheets(1).Range(Rng.Address)

'Convert to values
Rng2.Copy
Rng2.PasteSpecial xlPasteValues
Application.CutCopyMode = False

'Delete rows below
Rng2.Parent.Rows(Rng2.Rows(Rng2.Rows.Count).Row + 1 & ":65536").Delete

'Delete columns to right
DelCol2 = Chr(64 + Rng2.Parent.Columns(Rng2.Columns _
(Rng2.Columns.Count).Column + 1).Column)
Rng2.Parent.Columns(DelCol2 & ":IV").Delete

'Delete rows above
If Rng2.Rows(1).Row 1 Then
Rng2.Parent.Rows("1:" & Rng2.Rows(1).Row - 1).Delete
End If

'Delete columns to left
If Rng2.Columns(1).Column 1 Then
DelCol1 = Chr(64 + Rng2.Parent.Columns(Rng2.Columns(1).Column -
1).Column)
Rng2.Parent.Columns("A:" & DelCol1).Delete
End If

wb.SaveAs TempFile, xlHtml
wb.Close False

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

RangetoHTML = ts.ReadAll

ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile

End Function