跨工作簿多工作表插入表格时VBA代码遇类型不匹配错误

核心错误原因 #

你代码中table = wb2.Sheets(Pointer).Range("A1").CurrentRegion出现类型不匹配，是因为：

• Range.CurrentRegion返回的是一个Range对象，而你定义的table是String类型，无法直接将对象赋值给字符串变量。要把Excel表格插入到Outlook邮件的HTML正文，必须先把Range转换成HTML格式的字符串。

修复方案及代码优化 #

1. 添加Range转HTML的辅助函数 #

在模块中添加以下函数，用于将Excel区域转换为HTML表格：

Function RangeToHTML(rng As Range) As String
    Dim tempWB As Workbook
    Dim tempSH As Worksheet
    Dim tempPath As String
    
    ' 创建临时工作簿保存区域为HTML
    Set tempWB = Workbooks.Add(xlWBATWorksheet)
    Set tempSH = tempWB.Sheets(1)
    rng.Copy
    tempSH.Range("A1").PasteSpecial xlPasteValues
    tempSH.Range("A1").PasteSpecial xlPasteFormats
    
    ' 保存为临时HTML文件
    tempPath = Environ("TEMP") & "\temp_table.html"
    tempWB.SaveAs tempPath, xlHtml
    tempWB.Close False
    
    ' 读取HTML内容
    Dim fso As Object, ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.OpenTextFile(tempPath, 1)
    RangeToHTML = ts.ReadAll
    ts.Close
    Kill tempPath ' 删除临时文件
End Function

2. 修改原代码的关键错误点及优化 #

以下是修复后的完整代码，同时修正了HTML标签错误、变量类型、错误处理逻辑等潜在问题：

Sub Send_Mails_To_Drafts()
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Send_Mails")
    
    Dim wb2 As Workbook
    Set wb2 = Workbooks.Open("Path.xlsm") ' 替换为实际文件路径
    
    Dim Pointer As Long
    Dim table As String
    Dim i As Long ' 改用Long避免行数超出Integer范围
    Dim OA As Object
    Dim msg As Object
    Dim sign As String
    
    Set OA = CreateObject("outlook.application")
    
    Dim last_row As Long
    last_row = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row ' 更可靠的获取最后行方法
    
    For i = 2 To last_row
        ' 检查收件人是否为空，避免无效循环
        If sh.Range("A" & i).Value <> "" Then
            For Pointer = 3 To wb2.Sheets.Count
                ' 使用辅助函数将区域转为HTML字符串
                table = RangeToHTML(wb2.Sheets(Pointer).Range("A1").CurrentRegion)
                
                Set msg = OA.CreateItem(0)
                msg.To = sh.Range("A" & i).Value
                msg.CC = sh.Range("B" & i).Value
                msg.Subject = sh.Range("C" & i).Value
                
                ' 先获取签名，再设置HTML正文（修复标签错误）
                msg.Display ' 必须先Display才能获取默认签名
                sign = msg.HTMLBody
                msg.HTMLBody = "Dear Supervisor,<br/><br/>" & _
                               "See below the table of your least utilized units based on Work Order reporting for the last week. " & _
                               "Please note that we have reduced the period to <b><u>last week only</u></b> to avoid confusion of previous assignments.<br/><br/>" & _
                               "This list is limited to the <b><u>worst performing 10 units under 75%.</u></b> Our goal is to increase utilization on these units, " & _
                               "correct any misassigned units, or return any not-needed units. The spreadsheet attached provides detail on reporting. " & _
                               "If you have any questions about this report, please let your manager know.<br/><br/>" & _
                               "<b><font color=""green"">Expanse uses KPA to assign equipment to supervisors, to shop repairs, and between branches. " & _
                               "If any of your equipment is not assigned correctly, please contact your manager to do the correct assignment in KPA.</font></b><br/><br/>" & _
                               table & sign
                
                ' 添加附件（修复判断逻辑）
                If sh.Range("D" & i).Value <> "" Then
                    On Error Resume Next ' 捕获附件不存在的错误
                    msg.Attachments.Add sh.Range("D" & i).Value
                    On Error GoTo 0
                End If
                
                ' 保存为草稿
                On Error GoTo errHandler
                msg.Save ' 必须调用Save才能将邮件存入草稿箱
                sh.Range("F" & i).Value = "Draft Saved" ' 修改状态描述更准确
                
errHandler:
                If Err.Number <> 0 Then
                    MsgBox "处理第" & i & "行、第" & Pointer & "个工作表时出错: " & Err.Description
                    Err.Clear ' 重置错误状态
                End If
                Set msg = Nothing ' 释放对象
            Next Pointer
        End If
    Next i
    
    wb2.Close False ' 关闭数据源工作簿，不保存
    MsgBox "所有邮件草稿已生成完成"
End Sub

3. 其他关键优化点说明 #

• HTML标签修复：原代码中存在大量标签语法错误（如<br/、<b<），已修正为标准HTML格式，避免邮件正文显示异常。
• 变量类型优化：将i、last_row改为Long类型，避免因行数超过Integer的32767上限导致错误。
• 错误处理优化：添加错误重置逻辑，避免错误状态影响后续循环；捕获附件添加失败的异常。
• 循环逻辑优化：增加收件人非空判断，避免无效操作；添加对象释放语句Set msg = Nothing，减少内存占用。
• 草稿保存：新增msg.Save语句，确保邮件保存到Outlook草稿箱（原代码仅Display，关闭后不会留存）。

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