使用VBA脚本生成邮件时模板内容被重复复制的问题排查

你的代码存在几个关键问题，导致邮件出现替换内容与原模板内容共存的情况，同时还有变量未定义、范围选取不当等问题，逐一解决如下：

1. 核心问题：多次赋值HTMLBody导致的内容重复 #

直接多次对.HTMLBody赋值时，Outlook会反复解析HTML结构，可能自动添加冗余标签或保留原内容片段。正确做法是先将模板HTML内容存入临时变量，完成所有替换后再一次性赋值回.HTMLBody。

2. 变量未定义与赋值缺失 #

• x、y未定义且无赋值，strMail = row.Cells(x, y).Value会导致读取错误的单元格数据；
• strme、stryou、strQuant未定义也未从Excel读取数据，替换操作无法正常执行（若实际代码有赋值，需确保变量名和单元格引用正确）。

3. 数据范围选取错误 #

Set table = Range("A6", Range("A6").End(xlToRight).End(xlDown))的写法逻辑有误，会导致选取的范围超出实际数据区域，可能循环处理空行生成重复邮件。

修正后的完整代码 #

Option Explicit ' 强制变量定义，避免未定义变量错误

Sub SendMail()
    Dim sendTo As String
    Dim strSubject As String
    Dim OutApp As Object
    Dim OutMail As Outlook.MailItem
    Dim strMail As String
    Dim table As Range
    Dim row As Range
    Dim htmlContent As String
    Dim lastRow As Long, lastCol As Long
    ' 假设以下变量对应Excel中的数据列，根据实际情况调整
    Dim strme As String, stryou As String, strQuant As String
    
    Set OutApp = CreateObject("Outlook.Application")
    
    ' 正确选取数据范围：从A6到数据最后一行、最后一列
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    lastCol = Range("A6").End(xlToRight).Column
    Set table = Range("A6", Cells(lastRow, lastCol))
    
    For Each row In table.Rows
        ' 读取当前行的邮件地址（假设在第1列）
        strMail = row.Cells(1).Value
        ' 读取当前行的替换数据，根据实际列位置调整
        strme = row.Cells(2).Value ' 示例：第2列对应abc的替换值
        stryou = row.Cells(3).Value ' 示例：第3列对应myname的替换值
        strQuant = row.Cells(4).Value ' 示例：第4列对应hi的替换值
        
        strSubject = "Good morning"
        Set OutMail = OutApp.CreateItemFromTemplate("C:\Users\temp.oft")
        
        With OutMail
            .To = strMail
            .Subject = strSubject
            ' 先获取模板HTML内容，一次性完成所有替换
            htmlContent = .HTMLBody
            htmlContent = Replace(htmlContent, "abc", strme, vbTextCompare) ' vbTextCompare忽略大小写，避免匹配失败
            htmlContent = Replace(htmlContent, "myname", stryou, vbTextCompare)
            htmlContent = Replace(htmlContent, "hi", strQuant, vbTextCompare)
            .HTMLBody = htmlContent
            .Display ' 显示邮件
        End With
        
        Set OutMail = Nothing ' 每次循环清理对象
    Next row
    
    ' 清理对象
    Set OutApp = Nothing
End Sub

额外排查要点 #

• 检查Outlook模板（.oft文件）中的占位符是否与代码中的替换字符串完全一致（注意大小写、空格）；
• 确保Excel数据区域没有空行，避免生成无意义的邮件；
• 若模板包含图片或复杂HTML结构，需确认替换操作未破坏HTML标签的完整性。

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