在 outlook 365 的 HTML 邮件正文中删除 table 前后的换行符

Question

我正在尝试使用 vba 从 Outlook 365 发送电子邮件。在运行编码时，我在插入 table 之前和之后以及签名之后也出现了换行符。除此之外，我的编码工作完美。

谁能帮我找到删除不需要的换行符的解决方案

我从当前编码得到的结果：

编码预期结果：

下面是我创建的代码（参考 rondebruin）。

Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim StrBody As String
Dim SigString As String
Dim Signature As String


StrBody = "<BODY style = Font-size:11pt; font-fanily:calibri>" & _
      "Hi All" & "," & "<br>Attached is the list of opportunities which are created last week." & " 
<br><br>" & _
      "Please let me know if there is any concern or query." & "<br><br> <b> OPE details :</b>"


SigString = Environ("appdata") & _
            "\Microsoft\Signatures\sig.htm"

If Dir(SigString) <> "" Then
    Signature = GetBoiler(SigString)
Else
    Signature = ""
End If

On Error Resume Next
  
Workbooks.Open Filename:="C:\Work\Projects\Data\Data.xlsx"
Sheets("OPE details Pivot").PivotTables(1).TableRange1.Select

Set rng = Nothing
On Error Resume Next
Set rng = Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If rng Is Nothing Then
    MsgBox "The selection is not a range or the sheet is protected" & _
           vbNewLine & "please correct and try again.", vbOKOnly
    Exit Sub
End If

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
OutMail.SentOnBehalfOfName = ""
     .to = ""
     .CC = ""
     .Importance = 2
     .BCC = ""
     .Subject = "mail"
     .HTMLbody = StrBody & RangetoHTML(rng) & Signature & .HTMLbody
    .Display
End With
On Error GoTo 0

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

   
Set OutMail = Nothing
Set OutApp = Nothing

End Sub

下面是我通过参考 rondebruin 创建的 rangetoHTML 函数的编码。

Function RangetoHTML(rng As Range)
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

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
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
    .Cells(1).PasteSpecial Paste:=8
    .Cells(1).PasteSpecial xlPasteValues, , False, False
    .Cells(1).PasteSpecial xlPasteFormats, , False, False
     Cells.Select
     Cells.EntireRow.AutoFit
     Cells.EntireColumn.AutoFit
    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, -2)
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
End Function

最后是签名编码，我也是通过参考 rondebruin

创建的

Function GetBoiler(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function

Answer 1

在检查您的代码时，似乎在您调用 RangetoHtml(rng) 函数时出现了额外的行

.HTMLbody = StrBody & RangetoHTML(rng) & Signature & .HTMLbody

你能检查一下吗，或者分享我可以查看的代码。

Answer 2

感谢您分享信息。您的代码 (RangetoHtml) 看起来不错。

我怀疑，您所指的范围要转换为 html ，包括一个额外的行。你能检查一下你是否在范围内选择了一条额外的线吗？我认为在下面的代码中，额外的一行被选中。您可以通过运行下面的代码单独检查：

Sheets("OPE details Pivot").PivotTables(1).TableRange1.Select

Set rng = Selection.SpecialCells(xlCellTypeVisible)

Rng.copy

Answer 3

在 RangetoHTML 函数的“TempWB.Close”行之前添加以下行解决了我的问题。

RangetoHTML = Replace(RangetoHTML, "<!--[if !excel]>&nbsp;&nbsp;<![endif]-->", "")

在 outlook 365 的 HTML 邮件正文中删除 table 前后的换行符

Remove line breaks before and after table in HTML mail body in outlook 365

html

excel

outlook

vba