VBA: 将单元格区域作为邮件正文发送到指定邮箱

文章背景： 在工作中，有时需要将 单元格区域 的内容作为邮件正文发送到指定邮箱，如果希望邮件正文中的单元格区域带表格样式，则需要将其转换为html格式。

系统：Win10

发件邮箱：Outlook 365

VBA代码如下：

Option Explicit
Sub 发送邮件()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("test") '将"test"替换为你要操作的工作表名称
    '设置邮件参数
    Dim outlookApp As Object
    Set outlookApp = CreateObject("Outlook.Application")
    Dim mailItem As Object
    Set mailItem = outlookApp.CreateItem(0)
    With mailItem
        .To = "xxx" '将"xxx"替换为实际的收件人邮箱地址
        .Subject = "测试数据的最新日期" '将"邮件主题"替换为实际的邮件主题
        .HTMLBody = "详情如下：" & RangetoHTML(ws.Range("A1:G4")) '使用HTML格式的正文
        .Send '发送邮件
    End With
    '释放对象
    Set mailItem = Nothing
    Set outlookApp = Nothing
End Sub
Function RangetoHTML(rng As Range) As String
    '将单元格区域转化为HTML格式
    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"
    Set TempWB = Workbooks.Add(1)
    ' 复制范围到临时工作簿
    rng.Copy
    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
    ' 保存临时工作簿为HTML文件
    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
    ' 读取HTML文件内容
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    ' 删除临时文件和工作簿
    fso.DeleteFile TempFile
    TempWB.Close savechanges:=False