使用Excel VBA向Outlook邮件正文添加单元格区域时遇类型不匹配错误

错误原因分析 #

• 类型不匹配：OutMail.Body要求字符串类型，但代码中直接将ws.Range("h73:i100")（Range对象）与字符串拼接，导致类型冲突，触发错误'13'。
• 变量引用错误：字符串内的ws.cells(1, 2).value和ws.cells(73, 13).value未被解析为单元格实际值，会直接作为纯文本显示在邮件里。
• 循环逻辑冗余：For i = 2 To LastRow循环未使用变量i，所有单元格引用固定行，不符合循环批量发邮件的预期逻辑。

解决方案 #

1. 将单元格区域转换为可拼接的文本 #

编写辅助函数，把指定Range的内容转换为带格式的文本（每行单元格用制表符分隔，行与行用换行符分隔），确保能和字符串正常拼接。

2. 修正变量引用 #

将字符串内的单元格引用移出，用&符号拼接变量值，让代码正确读取单元格内容。

3. 调整循环逻辑（可选） #

如果需要按行循环发送邮件，用循环变量i引用当前行的收件人、名称等数据；若仅发送单封邮件，可直接移除循环代码块。

修改后的完整代码 #

Sub SendEmails()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim ws As Worksheet
    Dim LastRow As Long
    Dim i As Long
    Dim rangeText As String ' 存储单元格区域转换后的文本

    ' 创建Outlook应用对象
    Set OutApp = CreateObject("Outlook.Application")

    ' 设置数据所在工作表
    Set ws = ThisWorkbook.Sheets("Sheet3")

    ' 获取A列最后一行数据（如果需要循环发送，保留此步骤；否则可注释）
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' 循环发送邮件（如果仅发单封，可改为i=73或直接删除循环代码块）
    For i = 2 To LastRow
        ' 创建新邮件
        Set OutMail = OutApp.CreateItem(0)

        ' 转换指定单元格区域为可拼接的文本
        rangeText = GetRangeAsText(ws.Range("h73:i100"))

        With OutMail
            ' 收件人（若需循环取当前行数据，可改为ws.Cells(i, "D").Value）
            .To = ws.Cells(73, 12).Value
            ' 邮件主题
            .Subject = "Approval Requested -  " & ws.Cells(1, 2).Value
            ' 邮件正文
            .Body = "Hi, " & ws.Cells(73, 11).Value & vbNewLine & vbNewLine & _
                    "Please kindly approve the expenses below for " & ws.Cells(1, 2).Value & " on the " & ws.Cells(73, 13).Value & " tour. Thank you!" & vbNewLine & vbNewLine & _
                    rangeText & vbNewLine & vbNewLine & _
                    "Best Regards," & vbNewLine & "Aaron"

            ' 若要先预览邮件，替换.Send为.Display
            .Send
        End With

        Set OutMail = Nothing
    Next i

    Set OutApp = Nothing
End Sub

' 辅助函数：将Range转换为格式化文本
Function GetRangeAsText(rng As Range) As String
    Dim row As Range
    Dim cell As Range
    Dim rowText As String
    Dim resultText As String

    For Each row In rng.Rows
        rowText = ""
        ' 拼接当前行的每个单元格，用制表符分隔
        For Each cell In row.Cells
            rowText = rowText & cell.Value & vbTab
        Next cell
        ' 移除末尾多余制表符，添加换行
        resultText = resultText & Left(rowText, Len(rowText) - 1) & vbNewLine
    Next row

    GetRangeAsText = resultText
End Function

额外说明 #

• 如果不需要循环发送邮件，直接删除For i = 2 To LastRow和Next i代码块，单独执行邮件创建逻辑即可。
• 若要保留表格样式发送HTML格式邮件，可将.Body改为.HTMLBody，并修改辅助函数将Range转换为HTML表格代码。

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