VBA合并多工作表Range发送Outlook邮件类型不匹配问题求解

你的代码存在3个问题导致运行失败：

• &是字符串拼接运算符，无法直接作用于Range类型对象，且跨工作表的单元格区域本身就不能合并为单个Range对象
• 代码中CreateObejct存在拼写错误，正确写法为CreateObject
• 就算能合并Range，也无法实现三个区域之间间隔空行的排版要求，正确逻辑是分别将三个单元格区域转为HTML片段，中间插入空行标签后拼接为完整邮件正文。

不需要声明rngComb变量，直接拼接三个区域转换后的HTML内容，用<br><br>实现空行间隔，同时补上代码依赖的RangetoHTML转换函数，直接复制到VBA模块即可运行：

Sub combEmail()
    Dim OutApp As Object, OutMail As Object
    Dim rng1 As Range, rng2 As Range, rng3 As Range
    Dim htmlBodyContent As String

    ' 定义三个工作表的指定抓取区域
    Set rng1 = ThisWorkbook.Sheets("Sheet1").Range("C12:F14")
    Set rng2 = ThisWorkbook.Sheets("Sheet2").Range("C16:F18")
    Set rng3 = ThisWorkbook.Sheets("Sheet3").Range("H12:K14")

    ' 拼接正文内容，两个<br>标签实现区域间空一行的效果
    htmlBodyContent = RangetoHTML(rng1) & "<br><br>" & _
                      RangetoHTML(rng2) & "<br><br>" & _
                      RangetoHTML(rng3)

    ' 修正拼写错误创建Outlook对象
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = ThisWorkbook.Sheets("Sheet1").Range("A1").Value
        .Subject = "CombinedNotice"
        .HTMLBody = htmlBodyContent
        .Display ' 预览邮件，需要直接发送就替换为 .Send
    End With

    ' 释放对象占用
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

' Range转HTML通用函数，无需修改
Function RangetoHTML(rng As Range)
    Dim fso As Object, ts As Object, TempFile As String, 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, 1).PasteSpecial Paste:=8
        .Cells(1, 1).PasteSpecial xlPasteValues, , False, False
        .Cells(1, 1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1, 1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    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

    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=")

    TempWB.Close SaveChanges:=False
    Kill TempFile
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

• 运行前确保Outlook已正常配置邮箱账户，可正常收发邮件
• 转换后的邮件正文会保留Excel单元格原有的格式，包括边框、填充色、字体样式等
• 如果不需要弹出预览窗口直接发送，将.Display替换为.Send即可

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