如何修改VBA代码将Excel表格以纯文本粘贴到Outlook邮件正文

现有VBA代码通过HTML格式将Excel表格粘贴到Outlook邮件，但HTML格式导致邮件读取引擎异常。需要修改代码，把指定单元格区域转为纯文本插入邮件正文，而非HTML格式。

以下是适配后的完整代码：

Sub Auto_Send_Data()
    ThisWorkbook.Sheets("Sample Tab").Select
    Range("B4:B31").Select
    Selection.Copy
    ThisWorkbook.Sheets("Other Tab").Select
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
    ' 指定要使用的单元格区域（仅可见单元格）
    Set rng = Sheets("Other Tab").Range("A1:B30").SpecialCells(xlCellTypeVisible)

    If rng Is Nothing Then
        MsgBox "所选内容不是单元格区域，或工作表受保护。" & _
               vbNewLine & "请修正后重试。", vbOKOnly
        Exit Sub
    End If

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

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = ThisWorkbook.Sheets("Other Tab").Range("F1").Value
        .CC = ""
        .BCC = ""
        .Subject = ThisWorkbook.Sheets("Other Tab").Range("F2").Value
        ' 使用纯文本正文，调用RangeToPlainText函数转换区域
        .Body = RangeToPlainText(rng)
        ' 如需预览邮件，可替换.Send为.Display
        .Send
    End With
    On Error GoTo 0

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

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Function RangeToPlainText(rng As Range) As String
    Dim row As Range
    Dim cell As Range
    Dim rowText As String
    Dim plainText As String
    Dim colDelimiter As String
    Dim rowDelimiter As String

    ' 设置列分隔符（可按需调整，比如制表符vbTab或空格）
    colDelimiter = vbTab
    ' 设置行分隔符
    rowDelimiter = vbNewLine

    ' 遍历区域的每一行
    For Each row In rng.Rows
        rowText = ""
        ' 遍历当前行的每个单元格
        For Each cell In row.Cells
            ' 拼接单元格内容与列分隔符
            rowText = rowText & cell.Value & colDelimiter
        Next cell
        ' 移除行尾多余的列分隔符，添加行分隔符
        plainText = plainText & Left(rowText, Len(rowText) - Len(colDelimiter)) & rowDelimiter
    Next row

    ' 移除最后一行多余的行分隔符
    RangeToPlainText = Left(plainText, Len(plainText) - Len(rowDelimiter))
End Function

修改说明 #

• 替换原RangetoHTML函数为RangeToPlainText：该函数遍历目标单元格区域，用制表符（可自定义）分隔同一行的单元格，用换行符分隔不同行，生成规整的纯文本内容。
• 邮件正文属性从.HTMLBody改为.Body：直接使用Outlook的纯文本正文模式，避免HTML格式带来的兼容问题。
• 自定义分隔符：可根据需求修改colDelimiter的值，比如换成多个空格" "，让列内容对齐更直观。

内容的提问来源于stack exchange，提问作者tjdubz