读取额外行中的VBA TextStream对象结果
使用Ron de Bruin的RangeToHTML函数，我将一个范围粘贴到Outlook电子邮件中。 但是，看起来多余的空行被粘贴到电子邮件中，如下所示： 
我已经确认Source:=TempWB.Sheets(1).UsedRange.Address行只能正确抓取数据本身而不是多余的行。 我也确认RangetoHTML()的input范围也是正确的。 我唯一的猜测是.ReadAll方法是在文件中添加一个额外的行，但我不知道如何debugging。 这里是我用来简单参考的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
编辑：这是电子邮件正在生成的代码部分。 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
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的答案来replaceVBA中string中最后匹配的匹配项，我们可以在保留列宽的同时隐藏最后一行。
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的输出之后，我注意到第一行还强制列宽。 尽pipe如此，getTrimRangetoHTML将给出隐藏最后一行的所需结果。
我也遇到了同样的事情，我使用一些简单的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=")
似乎您必须在RangeToHTML过程中'Close TempWB之前包含以下代码行，以避免在HTML Body之上另外添加一行：
' >>> INSERTED CODE LINE: RangetoHTML = Replace(RangetoHTML, "<!--[if !excel]> <![endif]-->", "") ' Close TempWB TempWB.Close savechanges:=False ' .... ' ....