Чтение объекта TextStream VBA приводит к дополнительной строке

С помощью RangeToHTML функция от Рона де Бруина, я вставляю диапазон в электронную почту outlook. Тем не менее, кажется, что дополнительная пустая строка вставляется в электронную почту, как показано ниже:enter image description here

Я уже подтвердил, что Source:=TempWB.Sheets(1).UsedRange.Address line правильно захватывает только сами данные, а не дополнительную строку. Я также подтвердил, что диапазон ввода до RangetoHTML() - это тоже правильно. Мое единственное предположение, что .ReadAll способ как-то ввод дополнительной строки в файл, но я не уверен, как это отладить. Вот RangetoHTML функция, которую я использую для удобства:

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: вот часть кода, в которой генерируется электронное письмо. The RangeToHTML(rng_Summary) это то, что вставляет в письмо:

'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
8
excel excel-vba object outlook vba

3 ответов

Workbook.PublishObjects включает дополнительную строку для обеспечения ширины столбцов.

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

используя ответ @EngineerToast на заменить только последнее вхождение матча в строке в VBA мы можем скрыть последнюю строку, сохраняя ширину столбца.

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

дополнительное соглашение

после просмотра вывода RangetoHTML я заметил, что первая строка также обеспечивает ширину столбцов. Тем не менее, getTrimRangetoHTML даст желаемый результат скрытия последнего ряд.

2

у меня было то же самое со мной, и я исправил это, используя простой CSS.

tr:last-child {display:none;}

Если вы не знакомы с CSS, который должен быть помещен между тегами стиля, например:

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

помещено здесь в вашем коде:

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

кажется, что вы должны включить следующую строку кода перед 'Close TempWB в рамках процедуры RangeToHTML, чтобы избежать дополнительной строки поверх HTML Body:

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

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