[HELP] RangetoHTML

[bigpappi23]

Hi guys

I'm having problems with Ron de Bruin's RangetoHTML code. I'm trying to copy different ranges from my excel file into my email HTMLBody. What i did is, I put up multiple RangetoHTML functions, and each functions copies different ranges and converts them to HTML to be able to paste to the HTMLBody of my email. My problem is when the ranges are pasted to the HTMLBody. there are spaces between the ranges that i copied. can anyone help me on this. the copied ranges should not have any spaces between them and needs to look like they are 1 whole image or in my case it needs to look like they are a whole table.

thanks in advance guys,

Here's my code:


Sub SendOnTop()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2010
Dim rng As Range
Dim rng2 As Range
Dim OutApp As Object
Dim OutMail As Object
Set rng = Nothing
Set rng2 = Nothing
On Error Resume Next
'Only the visible cells in the selection
Set rng = Range("A6:D6").SpecialCells(xlCellTypeVisible)
Set rng2 = Range("A13:D14").SpecialCells(xlCellTypeVisible)

'You can also use a range if you want
'Set rng = Sheets("Sheet9").Range("A1:O83").SpecialCells(xlCellTypeVisible).Select
'Set rng = ActiveSheet.Range("A1:O83").SpecialCells(xlCellTypeVisible).Select

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 = ""
.CC = ""
.BCC = ""
.Subject = "Sample " & Date
.HTMLBody = RangetoHTML(rng) & RangetoHTML(rng2)
'.Send '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
.Cells(1).PasteSpecial xlPasteFormats
.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
Function RangetoHTML1(rng2 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
rng2.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)
RangetoHTML1 = ts.ReadAll
ts.Close
RangetoHTML1 = Replace(RangetoHTML1, "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






In this sample code. I only repeated the RangetoHTML function twice

thanks,

 

[daverunt]

Hi,

I think RangeToHTML generates an html page - body, html and table tags for the range converted.
Which means there are 2 html pages one on top of the other in your mail, each with a single range. I doubt the gap can be removed.

So the solution is to join the ranges into 1 before calling RangeToHTML.
Also, you only need to add RangeToHTML function once.

Set rng = Range("A6:D6").SpecialCells(xlCellTypeVisible)
Set rng2 = Range("A13:D14").SpecialCells(xlCellTypeVisible)

Set rng3 = Union(rng, rng2)


Outlook......
.HTMLBody = RangetoHTML(rng3)

How that affects the code for the different ranges you want to use, I don't know.

 

[daverunt]

Hi,

If you use Body instead of HTMLBody:

[B].Body[/B] = RangetoHTML(rng) & RangetoHTML(rng2)

your mail should display the html code generated by Excel so you can see the result.

 

[bigpappi23]

Hi daverunt,

thanks for the reply. the reason i have multiple RangetoHTML function is because i want to manipulate the ranges, because i want the other range to be on top of the other range. when i use this code:


Set rng = Range("A6:D6").SpecialCells(xlCellTypeVisible)Set rng2 = Range("A13:D14").SpecialCells(xlCellTypeVisible)Set rng3 = Union(rng, rng2)Outlook.......HTMLBody = RangetoHTML(rng3)they don't change places, the first selected range is always on top of the otherthanks,</PRE>

 

[bigpappi23]

maybe the "whitespace:nowrap" is the reason for the spaces between HTML. how can i disable this in excel vba?

thanks,

 

[daverunt]

If you generate a test mail using the .Body method I posted above you can cut and paste the content (html with tags) of the mail into Notpad and save it as test.html.
Launch the html file and you can see your space.
Open the html file with Notepad and work you way down to the second Body tag.
Under that you will see some script inside the first comment. It says If Not excel .... (in code format)
If you delete that line, save the file and refresh the open web page the space disappears.
Also note that the style for the Table already uses whitespace-nowrap.

The point is that it is Excel generating your problem. So that's why I suggested Union in previous post.