基于Excel表头与指定行批量生成带表格的邮件技术求助

原代码核心问题 #

1. 邮件正文（sHTMLBody）和表格数据（sTableData）在遍历行的循环外生成，仅使用初始激活行的数据，导致所有邮件内容重复
2. 依赖ActiveCell.Select操作单元格，逻辑不稳定且效率低
3. 表格数据拼接存在语法错误：错误将赋值语句嵌入字符串拼接中
4. 循环变量使用VBA关键字Name，存在命名冲突风险

修改后的完整代码 #

Sub PLGBarcodeFile()
    Dim EApp As Object
    Set EApp = CreateObject("Outlook.Application")
    
    Application.ScreenUpdating = False
    
    Dim EItem As Object
    Dim ws As Worksheet
    Set ws = Worksheets("Sent Email") ' 缓存工作表对象，提升性能
    
    Dim NameList As Range
    Set NameList = ws.Range("A2", ws.Range("A2").End(xlDown))
    
    ' 预先生成表格表头，仅需执行一次
    Dim iColumnsCount As Integer, iColCnt As Integer
    Dim sTableHeads As String
    iColumnsCount = ws.UsedRange.Columns.Count
    
    For iColCnt = 1 To iColumnsCount
        If sTableHeads = "" Then
            sTableHeads = "<th>" & ws.Cells(1, iColCnt) & "</th>"
        Else
            sTableHeads = sTableHeads & "<th>" & ws.Cells(1, iColCnt) & "</th>"
        End If
    Next iColCnt
    
    ' 预先生成表格样式，仅需执行一次
    Dim sTableStyle As String
    sTableStyle = "<style> table.edTable { width: 75%; font: 18px calibri; } table, table.edTable th, table.edTable td { border: solid 1px #000000; border-collapse: collapse; padding: 3px; text-align: center; } table.edTable td { background-color: #ffffff; color: #000000; font-size: 14px; } table.edTable th { background-color : #ffffff; color: #000000; } tr:hover td { background-color: #000000; color: #ffffff; } </style>"
    
    ' 遍历每一行生成邮件
    Dim rowIdx As Integer
    For rowIdx = 1 To NameList.Count
        Dim currentRow As Integer
        currentRow = NameList(rowIdx).Row ' 获取当前循环对应的工作表行号
        
        ' 生成当前行的表格数据
        Dim sTableData As String
        sTableData = "<tr>"
        For iColCnt = 1 To iColumnsCount
            sTableData = sTableData & "<td>" & ws.Cells(currentRow, iColCnt) & "</td>"
        Next iColCnt
        sTableData = sTableData & "</tr>"
        
        ' 组装当前行对应的邮件HTML正文
        Dim sHTMLBody As String
        sHTMLBody = "Dear " & ws.Cells(currentRow, 10) & "," & "<br><br>" _
                  & "<br><br>" _
                  & "(" & Date & ")." & "<br><br>" _
                  & "<b>Current/Old process: </b>" & "<br>" _
                  & "<br><br>" _
                  & "<b>New process: </b>" & "<br>" _
                  & "<br><br>" _
                  & "<br>" _
                  & "<b>Action for you:</b>" & "<br>" _
                  & "<br><br>" _
                  & sTableStyle & "<table class='edTable'><tr>" & sTableHeads & "</tr>" & sTableData & "</table><br><br>" _
                  & "<br>" _
                  & "<br>"
        
        ' 创建并配置邮件
        Set EItem = EApp.CreateItem(0)
        With EItem
            .To = ws.Cells(currentRow, 9)
            .Subject = "Evaluate information regarding barcodes for " & ws.Cells(currentRow, 2)
            .HTMLBody = sHTMLBody
            .Display ' 如需直接发送可改为 .Send
        End With
    Next rowIdx
    
    Application.ScreenUpdating = True
End Sub

关键修改说明 #

• 缓存工作表对象：将Worksheets("Sent Email")赋值给变量ws，避免重复调用，提升代码运行效率
• 直接使用行号遍历：通过NameList(rowIdx).Row获取当前行号，完全摒弃ActiveCell操作，逻辑更稳定
• 将动态内容移入循环：表格数据和邮件正文的生成逻辑放到行循环内部，确保每封邮件对应当前行的专属数据
• 修复语法错误：移除了表格数据拼接中的错误赋值语句
• 替换冲突变量名：将循环变量Name改为rowIdx，避免与VBA内置关键字冲突
• 预生成静态内容：表头和表格样式仅在循环外生成一次，减少重复计算

内容的提问来源于stack exchange，提问作者Esben Holm Hjørringgaard