Ron de Bruin RangetoHTML adds a carriage return when inserting the cell range into message body

[gurumagic]

I am using Ron de Bruin RangetoHTML code. I have C5 with a value or test and red font. When I run the code, my email opens and cell C5 is added to the body and retains it's formatting of red font.

My problem is that it puts a carriage return first and then places the value of C5. The code below produces this:

This is a
test

When I really want it to produce:
This is a test

I've stepped through the code, searched online for hours, but can't seem to figure this out. Any help would be greatly appreciated.

Thanks in advance.


Current Code:

Sub Mail_Selection_Range_Outlook_Body1()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2010
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object


Set rng = Nothing
On Error Resume Next
'Only the visible cells in the selection
'Set rng = Selection.SpecialCells(xlCellTypeVisible)
'You can also use a range if you want
Set rng = Sheets("Sheet1").Range("C5").SpecialCells(xlCellTypeVisible)
On Error GoTo 0


If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If


With Application
.EnableEvents = False
.ScreenUpdating = False
End With


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


On Error Resume Next
With OutMail
.To = "gurumagic@test.com"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = "This is a test" & " " & RangetoHTML(rng)
.Display 'or use .Display
End With
On Error GoTo 0


With Application
.EnableEvents = True
.ScreenUpdating = True
End With


Set OutMail = Nothing
Set OutApp = Nothing
End Sub



Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2010
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With

'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With

'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center xublishsource=", _
"align=left xublishsource=")

'Close TempWB
TempWB.Close savechanges:=False

'Delete the htm file we used in this function
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function

 

[Dryver14]

.Cells(1).PasteSpecial Paste:=8

Not sure of the value of this line,
try commenting it out.

 

[gurumagic]

.Cells(1).PasteSpecial Paste:=8

Not sure of the value of this line,
try commenting it out.

Thanks for parsing the code. I commented this line out and it didn't seem to have any affect on the output.

 

[mvsub1]

How about replacing this code

[COLOR=#574123].Cells(1).PasteSpecial Paste:=8[/COLOR]
[COLOR=#574123].Cells(1).PasteSpecial xlPasteValues, , False, False[/COLOR]
[COLOR=#574123].Cells(1).PasteSpecial xlPasteFormats, , False, False[/COLOR]
[COLOR=#574123].Cells(1).Select[/COLOR]

With this code

.Cells(1) = "This is a "
.Cells(2).PasteSpecial Paste:=8
.Cells(2).PasteSpecial xlPasteValues, , False, False
.Cells(2).PasteSpecial xlPasteFormats, , False, False
.Range(.Cells(1), .Cells(2)).Select

This way you're not pasting the text as one block but as different cells, but maybe it works for you.

 

[gurumagic]

Ok. I tried this out and it could work. I changed the text, "This is a" to "Bob will need to remove" and it only comes back with "Bob will" in the email so it is truncating characters.

Also, my end goal is to basically look something like this:

Today:
Bob will need to remove Server Week 1 from the server and replace it with Server Week 2. Sever Week 1 will need to be passed to Bill to take home.


Next Week:
Bill will need to bring back Server Week 3 from home to be placed in the server on Friday.


Call me with any questions.


Thanks

Week 1, Week 2, and Week 3 are all values coming from Excel.

In this example
Week1 is the value from rng1
Week2 is the value from rng2
Week3 is the value from rng3

Which cell I will use will depend on what day it is. I plan to use an expression that looks at column A to find today's date and then set the = today then rng1 = to a cell in the same row from column B and so on for rng2 and rng3.

I'm still toying around with your suggestion to see if I can make it work. Any further assistance is greatly appreciated. Thanks for the help you have provided thus far.

 

[mvsub1]

The issue with using the function RangeToHTML is that it treats the text that exceeds the column width as hidden text and pastes it as such into the email:
<span

[td class=xl1522522 width=64 style='width:48pt']Bob will n[span style='display:none'>eed to remove[/span][/td]

A workaround is to add the following line below the code of my previous post:

.Columns(2).EntireColumn.AutoFit

However, I think there are less complicated ways to compose emails from Excel.
Is there a specific reason why you use the RangeToHTML function?</span

 

[mvsub1]

How about:

Dim wk As String
wk = Sheets(1).Range("C5")

And replace the code for the body of the email message with:

.HTMLBody = "Bob wil need to remove Server " & "<font color=" & Chr(34) & "red" & Chr(34) & ">" & wk & "</font>"

Then you can adjust it to your needs to make 'wk' the week you want according to the date of today.

 

[gurumagic]

To be honest, I was using RangetoHTML because I simply wanted to keep the formatting from excel.

I'm pretty new to this coding stuff so it seemed like the right place to start. You last suggestion makes sense. I will try to play around with that and see how it turns out. If I can't come up with it, maybe I can post a sample of the excel for clarity.

Thanks a ton for your help thus far. I'll follow back up early next week.

 

[gurumagic]

SOLVED!!

Thank you mvsub1!

Your suggestion worked perfectly! I can't believe it was that simple. Cheers!

.HTMLBody = "Bob wil need to remove Server " & "" & Chr(34) & "red" & Chr(34) & ">" & wk & ""