使用 VBA Excel 发送电子邮件 - 添加 html 文本并在电子邮件中引用文本答案

【问题标题】：Send e-mail using VBA Excel - add html Text and also reference text in email使用 VBA Excel 发送电子邮件 - 添加 html 文本并在电子邮件中引用文本
【发布时间】：2020-11-18 16:30:28
【问题描述】：

我目前有一个纯文本电子邮件 vba，其模板设置如下所示。我正在尝试将其修改为 html 以保持格式显示，或者让我自己修改以具有该格式。请注意；单元格 b4 和 b6 具有自动更新某些字段的公式，例如来自另一个选项卡的数字和日期。

Sub sumit()
Dim mainWB As Workbook
Dim SendID
Dim CCID
Dim Subject
Dim Body
Set otlApp = CreateObject("Outlook.Application")
Set olMail = otlApp.CreateItem(olMailItem)
Set mainWB = ActiveWorkbook
SendID = mainWB.Sheets("Mail").Range("B1").Value
CCID = mainWB.Sheets("Mail").Range("B2").Value
Subject = mainWB.Sheets("Mail").Range("B3").Value
Body = mainWB.Sheets("Mail").Range("B4").Value & vbNewLine & mainWB.Sheets("Mail").Range("B6").Value & vbNewLine & mainWB.Sheets("Mail").Range("B8").Value & vbNewLine & mainWB.Sheets("Mail").Range("B11").Value

With olMail
.To = SendID
If CCID <> "" Then
.CC = CCID
End If
.Subject = Subject
.Body = Body
.Display

Example of what I have

【问题讨论】：

标签： excel vba email developer-tools

【解决方案1】：

您可以尝试使用函数将范围转换为 html。它将创建临时工作簿。下面的函数你需要粘贴到标准模块上。

Public 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(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, -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

和您的代码已编辑。我不确定我是否正确设置了 rng_Body，所以请检查一下。


Sub sumit()
Dim mainWB As Workbook
Dim SendID
Dim CCID
Dim Subject
Dim rng_Body as range
Set otlApp = CreateObject("Outlook.Application")
Set olMail = otlApp.CreateItem(olMailItem)
Set mainWB = ActiveWorkbook
set rng_Body = mainWB.Sheets("Mail").usedrange

SendID = mainWB.Sheets("Mail").Range("B1").Value
CCID = mainWB.Sheets("Mail").Range("B2").Value
Subject = mainWB.Sheets("Mail").Range("B3").Value


With olMail
.To = SendID
If CCID <> "" Then
.CC = CCID
End If
.Subject = Subject
.htmlbody = "some text upper" & vbcrlf &  RangetoHTML(rng_Body) & vbcrlf & "Some text below"
.Display

【讨论】：

【解决方案2】：

不要使用 .Body，而是使用 .htmlBody

即，

strHTML = "<html><body>"
strHTML = strHTML & "<h2>Thank you very much for your order. Attached is a copy of your order acknowledgement.</h2>"
strHTML = strHTML & "</body></html>"
.htmlBody = strHTML

【讨论】：