Excel单元格区域复制到邮件正文的替代方案咨询（解决临时文档过多崩溃问题）

我完全理解你现在的困扰——用RangeToHTML函数时生成大量临时文档，导致工具频繁崩溃，而且尝试直接复制Excel区域到邮件正文也没成功，确实得换个更高效的思路。下面给你几个实用的替代方案：

方案一：直接通过Outlook的Word编辑器粘贴（无临时文件） #

这个方法跳过了生成临时HTML文件的步骤，直接利用Outlook内置的Word编辑器来粘贴Excel区域，从根源上避免临时文件堆积。代码示例如下：

Sub PasteRangeToEmailDirectly()
    Dim olApp As Object
    Dim olMail As Object
    Dim targetRng As Range
    
    ' 替换为你需要复制的目标区域
    Set targetRng = ThisWorkbook.Sheets("你的工作表名").Range("A1:D10")
    
    ' 初始化Outlook对象
    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(0) ' 创建新邮件
    
    targetRng.Copy ' 复制Excel区域到剪贴板
    
    With olMail
        .BodyFormat = 2 ' 将邮件正文设置为HTML格式（2对应olFormatHTML）
        .Display ' 必须先显示邮件，才能调用Word编辑器对象
        ' 直接将剪贴板内容粘贴到邮件正文
        .GetInspector.WordEditor.Range.Paste
        ' 可按需设置邮件主题、收件人等
        .Subject = "Excel区域数据同步"
        '.To = "收件人邮箱@xxx.com"
    End With
    
    ' 释放对象，避免内存占用
    Set olMail = Nothing
    Set olApp = Nothing
End Sub

注意：如果之前直接复制没成功，大概率是没先调用.Display显示邮件，或者没把正文格式设为HTML——Outlook在未显示邮件时，无法访问Word编辑器进行粘贴操作。

方案二：改进原RangeToHTML函数，及时清理临时文件 #

如果不想完全替换现有代码，可以给原函数加上临时资源清理逻辑，每次生成HTML后立刻删除临时文件和工作簿，避免堆积。修改后的函数如下：

Private Function RangeToHTML(rng As Range) As String
    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"
    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
    
    ' 发布为HTML文件
    TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic).Publish (True)
    
    ' 读取HTML内容
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set ts = Fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangeToHTML = ts.ReadAll
    ts.Close
    
    ' ====== 关键：清理临时资源 ======
    TempWB.Close SaveChanges:=False ' 关闭临时工作簿，不保存
    Kill TempFile ' 删除临时HTML文件
    ' 释放对象
    Set TempWB = Nothing
    Set ts = Nothing
    Set Fso = Nothing
End Function

原函数的问题大概率是没有及时清理临时工作簿和HTML文件，导致系统临时文件夹里积累了大量文件，最终引发崩溃——加上这段清理逻辑后，每次生成HTML就立刻删除临时文件，不会再堆积。

备注：内容来源于stack exchange，提问作者Lupus