Function RangetoHTML(rng As Range)
' Code of Ron de Bruin - https://www.rondebruin.nl/win/s1/outlook/bmail2.htm
' Working in Excel 2000-2016
' (ZVI-2018-01-05: modified for CF supporting)
Dim TempFile As String, ddo As Long
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
' Temporary publish the rng range to a htm file
ddo = ActiveWorkbook.DisplayDrawingObjects
ActiveWorkbook.DisplayDrawingObjects = xlHide
With ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=ActiveSheet.Name, _
Source:=Union(rng, rng).Address, _
HtmlType:=xlHtmlStatic)
.Publish True
.Delete
End With
ActiveWorkbook.DisplayDrawingObjects = ddo
'Read all data from the htm file into RangetoHTML
With CreateObject("Scripting.FileSystemObject").GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = Replace(.ReadAll, "align=center x:publishsource=", "align=left x:publishsource=")
.Close
End With
'Delete the htm file we used in this function
Kill TempFile
End Function