vba - How to preserve/retain hyperlinks in email body when using RangetoHTML from Excel -

i using ron de bruin's rangetohtml example send email selection on current worksheet in excel. working perfectly, 2 columns of sheet contain hyperlinks coming plain text (and not clickable). further tried implement suggestion mail range formatting through vba in excel , added "for each hyperl" loop, after doing surprisingly whole email body comes out empty. can see temp file not empty, hyperlinks missing there too.

below example - appreciating ideas on have done wrong!

function rangetohtml(rng range) dim fso object dim ts object dim tempfile string dim tempwb workbook dim hlink hyperlink  tempfile = environ$("temp") & "\" & format(now, "dd-mm-yy h-mm-ss") & ".htm"  'copy range , create new workbook past data in rng.copy set tempwb = workbooks.add(1) tempwb.sheets(1)     .cells(1).pastespecial paste:=8     .cells(1).pastespecial paste:=xlpastevalues     .cells(1).pastespecial paste:=xlpasteformats     .cells(1).select     application.cutcopymode = false     on error resume next     .drawingobjects.visible = true     .drawingobjects.delete     on error goto 0 end  each hlink in rng.hyperlinks     tempwb.sheets(1).hyperlinks.add _     anchor:=tempwb.sheets(1).range(hlink.range.address), _     address:=hlink.address, _     texttodisplay:=hlink.texttodisplay next hlink   'publish sheet htm file tempwb.publishobjects.add( _      sourcetype:=xlsourcerange, _      filename:=tempfile, _      sheet:=tempwb.sheets(1).name, _      source:=tempwb.sheets(1).usedrange.address, _      htmltype:=xlhtmlstatic)     .publish (true) end  'read data htm file rangetohtml set fso = createobject("scripting.filesystemobject") set ts = fso.getfile(tempfile).openastextstream(1, -2) rangetohtml = ts.readall ts.close rangetohtml = replace(rangetohtml, "align=center x:publishsource=", _                       "align=left x:publishsource=")  'close tempwb tempwb.close savechanges:=false  'delete htm file used in function kill tempfile  set ts = nothing set fso = nothing set tempwb = nothing end function 

here calling subroutine code:

code sub sendbugreport() dim source range dim dest workbook dim wb workbook dim tempfilepath string dim tempfilename string dim fileextstr string dim fileformatnum long dim outapp object dim outmail object

set wb = activeworkbook set source = nothing on error resume next set source = selection.specialcells(xlcelltypevisible) on error goto 0  if source nothing     msgbox "the source not range or sheet protected, please correct , try again.", vbokonly     exit sub end if  application     .screenupdating = false     .enableevents = false end  set outapp = createobject("outlook.application") set outmail = outapp.createitem(0)  on error resume next outmail         .to = sheets("email subject , dlist").range("b1").value         .cc = ""         .bcc = ""         .subject = sheets("email subject , dlist").range("b5").value         .htmlbody = rangetohtml(source)         .display end on error goto 0 '    .close savechanges:=false  set outmail = nothing set outapp = nothing  application     .screenupdating = true     .enableevents = true end end sub 

i came across following link in this.

as summary, adding following in rangetohtml() suffice:

at top:

dim hlink hyperlink 

just before publish code:

for each hlink in rng.hyperlinks tempwb.sheets(1).hyperlinks.add _ anchor:=tempwb.sheets(1).range(hlink.range.address), _ address:=hlink.address, _ texttodisplay:=hlink.texttodisplay next hlink