mail range

[donnyp02]

I'm trying to copy the data in range B5:Q9 directly into an email, if i physically copy and past it into outlook, it takes the colors and format and everything, that what I'm trying to achieve with this button, any ideas? Thanks in advance!

Private Sub Email_WB_Click()
RSet WBRange = Range("B5:Q9").Copy
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.createitem(olmailitem)
With myItem
.Recipients.Add "donald@company.com"
.Body = WBRange
.Subject = "Employee Time Accurals"
End With
myItem.Send
End Sub

[debauch]

This is one way of doing it.
Add this code as a module :

Public Function SheetToHTML(sh As Worksheet)

Dim TempFile As String
Dim fso As Object
Dim ts As Object
Randomize
sh.Copy
TempFile = sh.Parent.Path & "\TmpHTML" & Int(Rnd() * 10) & ".htm"
ActiveWorkbook.SaveAs TempFile, xlHtml
ActiveWorkbook.Close False
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
SheetToHTML = ts.ReadAll
ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile

End Function


Then in your code u have listed there, just add :

.HTMLBody = sheetToHTML(thisworkbook.sheets(3))
.display


Let me know if that works. My Outlook code varies slightly, but works great, w/ links, color, etc.
PS - mine is on sheet 3 , but change that to what page your is that your copying.

[donnyp02]

Thanks for your help!!!

I tried that and I'm getting an error:

Compile Error:
Invalid or unqualified reference

On:
.HTMLBody = SheetToHTML(ThisWorkbook.Sheets(1))
on the sheet the name is actually Total, I tried that and 1 and neither worked.

Thanks again!!

[debauch]

Can you attach the file you are using, or a mock file? Also, did u add the oulook reference ?

Also, not sure how this differs, but this is the code I use to send it...might be sublte differences.


Sub SheetInBody() Ole Function for each employeee
Dim olApp As Outlook.Application
Dim olMail As MailItem
Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
With olMail
.To = "person@email.com"
.Subject = "SLA Service Impacting Delays"
.HTMLBody = SheetToHTML(ThisWorkbook.Sheets(3))
.Display
End With
' Set olMail = Nothing
' Set olApp = Nothing
'End Sub