Reading VBA TextStream Object Results in Extra Line

Question

Using the RangeToHTML function from Ron de Bruin, I'm pasting a range into an outlook email. However, it seems that an extra blank row is being pasted into the email as seen below:

I've already confirmed that the Source:=TempWB.Sheets(1).UsedRange.Address line is correctly grabbing only the data itself and not an extra line. I've also confirmed that the input range to RangetoHTML() is also correct. My only guess is that the the .ReadAll method is somehow putting an extra line in the file, but I'm not sure how to debug that. Here's the RangetoHTML function I'm using for easy reference:

Function RangetoHTML(rng As Range)
' By Ron de Bruin.
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

Application.ScreenUpdating = False
Application.EnableEvents = False

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
If rng Is Nothing Then GoTo Skip

rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
    .Cells(1, 2).PasteSpecial Paste:=8
    .Cells(1, 2).PasteSpecial xlPasteFormats
    .Cells(1, 2).PasteSpecial xlPasteValues
    .Cells.Font.Name = "Calibri"
    .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)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                      "align=left x:publishsource=")

'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

Skip:

Application.ScreenUpdating = True
End Function

EDIT: Here's the portion of code where the email is being generated. The RangeToHTML(rng_Summary) is what inserts the range into the email:

'Construct the actual email in outlook
With OutMail
    .to = "LastName, FirstName"
    .CC = ""
    .BCC = ""
    .Subject = "LOB Break Status (As of " & Format(Now(), "m/d") & ")"
    .HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>Here is the latest status for the breaks, by product, in the LOB:" & _
                RangetoHTML(rng_Summary) & _
                "<BODY style=font-size:9pt;font-family:Calibri>*allows are excluded from Avg. Age of Breaks calculation" & _
                "<ul>" & _
                    "<li>" & _
                        "<BODY style=font-size:11pt;font-family:Calibri><u><b>Average Age of Breaks</u></b>" & Chr(150) & " " & avg_age_change & " from " & avg_break_age_prev & " to " & avg_break_age_curr & " due to ________" & _
                    "</li>" & _
                "</ul>"
    .Display 'CHANGE THIS to .Display/.Send if you want to test/send
End With

Can you post the full HTML? From what I can see, your HTML might have a few issues. The snippet you've posted has three Body tags (four if you include the result from RangetoHTML) Could you try and email a copy to yourself and then view the source of that email to see where it might be going wrong? — Eliot, Nov 09 '17 at 00:41

score 2 · Accepted Answer · answered Nov 04 '17 at 04:56

2

Workbook.PublishObjects includes an extra row to enforce column widths.

 <![if supportMisalignedColumns]>
 <tr height=0 style='display:none'>
  <td width=64 style='width:48pt'></td>
  <td width=64 style='width:48pt'></td>
 </tr>
 <![endif]>

Using the @EngineerToast's answer to Replace only last occurrence of match in a string in VBA we can hide the last row while preserving column widths.

Function getTrimRangetoHTML(rng As Range) As String
    Const OldText = "display:none"
    Const NewText = "visibility: hidden;"
    Dim s As String
    s = RangetoHTML(rng)
    s = StrReverse(Replace(StrReverse(s), StrReverse(OldText), StrReverse(NewText), , 1))
    getTrimRangetoHTML = s

    With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .SetText s
        .PutInClipboard
    End With
End Function

Addendum

After reviewing RangetoHTML's output I noticed that the first row also enforces the column widths. Nonetheless, getTrimRangetoHTML will give the desired result of hidding the last row.

answered Nov 04 '17 at 04:56

The replace works as expected (verified with `Debug.Print`), but the extra line persists at the bottom. Any ideas? – kschindl Nov 14 '17 at 19:17
I'm not sure. You might be interested in my post on Code Review: [Creating HTML using a Builder Pattern](https://codereview.stackexchange.com/questions/178814/creating-html-using-a-builder-pattern). It contains a class that makes it easy to build HTML. – Nov 14 '17 at 19:25
Haven't taken a look at that post just yet, but I figured that if I could set a condition for the IF block to never execute, then the additional row wouldn't happen. So, I did `Const OldText = "supportMisalignedColumns" ` and `Const NewText = "1=0"`. Not elegant, but it suits my purpose. Thanks for your help! – kschindl Nov 15 '17 at 17:10
@kschindl cleaver. How about `HTML = Replace(HTML, "supportMisalignedColumns", False)`? Thanks for accepting my answer – Nov 15 '17 at 23:39

braX · Answer 2 · 2017-08-29T18:17:58.430

0

I've had this exact same thing happen to me, and I fixed it using some simple CSS.

tr:last-child {display:none;}

If you are not familiar CSS, that needs to be placed between style tags, like this:

<style> tr:last-child {display:none;} </style>

Placed here in your code:

RangetoHTML = "<style> tr:last-child {display:none;} </style>" & Replace(RangetoHTML, "align=center x:publishsource=", _
                      "align=left x:publishsource=")

edited Aug 29 '17 at 18:17

answered Aug 29 '17 at 17:53

braX

11,506
5
20
33

Updated answer. – braX Aug 29 '17 at 18:18
This didn't solve the issue for me :(. The cells copied into the email still have an extra blank row at the bottom. – kschindl Aug 29 '17 at 18:40
That's odd. Works just fine for me. Not really sure what to tell you. Maybe someone else will have an idea. – braX Aug 29 '17 at 18:45

score 0 · Answer 3 · answered Nov 03 '17 at 18:28

Seems that you have to include the following code line before 'Close TempWB within the RangeToHTML procedure to avoid an additional line on top of HTML Body:

    ' >>> INSERTED CODE LINE:
      RangetoHTML = Replace(RangetoHTML, "<!--[if !excel]>&nbsp;&nbsp;<![endif]-->", "")

    ' Close TempWB
      TempWB.Close savechanges:=False
    ' .... 
    ' ....

Reading VBA TextStream Object Results in Extra Line

3 Answers3

Addendum