Question

使用Ron de Bruin的RangeToHTML功能，我将范围粘贴到Outlook电子邮件中。但是，似乎在电子邮件中粘贴了一个额外的空行，如下所示：

我已经确认Source:=TempWB.Sheets(1).UsedRange.Address行正确抓取数据本身而不是额外的行。我还确认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

编辑：这是生成电子邮件的代码部分。 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

Answer 1

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对Replace only last occurrence of match in a string in 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将提供隐藏最后一行的预期结果。

Answer 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=")

Answer 3

似乎您必须在RangeToHTML过程中的'Close TempWB之前包含以下代码行，以避免在HTML Body之上添加额外的行：

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

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

读取额外行中的VBA TextStream对象结果

3 个答案:

附录