求Excel Macro代码：将表格每行数据发送为独立Outlook邮件

以下是实现需求的VBA宏代码，它会遍历Excel表格中的每行数据，自动生成并发送Outlook邮件，邮件内容会提取指定列的信息并附加固定文本：

Sub SendRowEmails()
    Dim olApp As Outlook.Application
    Dim olMail As Outlook.MailItem
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim emailCol As Integer, callCol As Integer, typeCol As Integer, balanceCol As Integer, compCol As Integer
    Dim i As Long
    Dim emailBody As String
    
    ' 设置目标工作表（可根据实际修改表名）
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 初始化Outlook应用
    Set olApp = New Outlook.Application
    
    ' 根据表头名称匹配对应列的位置
    On Error Resume Next
    emailCol = ws.Rows(1).Find(What:="Email", LookIn:=xlValues, LookAt:=xlWhole).Column
    callCol = ws.Rows(1).Find(What:="Call", LookIn:=xlValues, LookAt:=xlWhole).Column
    typeCol = ws.Rows(1).Find(What:="Type", LookIn:=xlValues, LookAt:=xlWhole).Column
    balanceCol = ws.Rows(1).Find(What:="Balance", LookIn:=xlValues, LookAt:=xlWhole).Column
    compCol = ws.Rows(1).Find(What:="Company Name", LookIn:=xlValues, LookAt:=xlWhole).Column
    On Error GoTo 0
    
    ' 检查是否找到所有必要列
    If emailCol = 0 Or callCol = 0 Or typeCol = 0 Or balanceCol = 0 Or compCol = 0 Then
        MsgBox "未找到指定的表头列，请检查表格第一行的列名是否正确", vbExclamation
        Exit Sub
    End If
    
    ' 获取数据区域的最后一行行号
    lastRow = ws.Cells(ws.Rows.Count, emailCol).End(xlUp).Row
    
    ' 遍历每行数据（从第二行开始，跳过表头）
    For i = 2 To lastRow
        ' 跳过空邮箱行
        If ws.Cells(i, emailCol).Value <> "" Then
            Set olMail = olApp.CreateItem(olMailItem)
            
            ' 设置收件人邮箱
            olMail.To = ws.Cells(i, emailCol).Value
            
            ' 设置邮件主题（可根据需求自定义）
            olMail.Subject = "关于" & ws.Cells(i, compCol).Value & "的账户通知"
            
            ' 构建HTML格式的邮件正文
            emailBody = "<html><body>"
            emailBody = emailBody & "<p>Call: " & ws.Cells(i, callCol).Value & "</p>"
            emailBody = emailBody & "<p>Type: " & ws.Cells(i, typeCol).Value & "</p>"
            emailBody = emailBody & "<p>Balance: " & ws.Cells(i, balanceCol).Value & "</p>"
            emailBody = emailBody & "<p>Company Name: " & ws.Cells(i, compCol).Value & "</p>"
            emailBody = emailBody & "<p><em><strong>Body of email</strong></em></p>"
            emailBody = emailBody & "</body></html>"
            
            olMail.HTMLBody = emailBody
            
            ' 直接发送邮件（若需先预览，可替换为olMail.Display）
            olMail.Send
            
            ' 释放邮件对象
            Set olMail = Nothing
        End If
    Next i
    
    ' 释放Outlook应用对象
    Set olApp = Nothing
    
    MsgBox "邮件发送完成！", vbInformation
End Sub

使用注意事项： #

• 确保Excel表格第一行是表头，包含Email、Call、Type、Balance、Company Name这些列名
• 打开VBA编辑器（按Alt+F11），点击「工具」→「引用」，勾选Microsoft Outlook Object Library后点击确定
• 运行宏前请保存Excel文件，避免数据意外丢失
• 若需要先预览邮件再发送，可将代码中的olMail.Send替换为olMail.Display

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