Excel VBA自动化邮件需求：遍历列满足条件时自动发Outlook邮件

问题分析 #

原代码存在以下核心问题：

• 缺少遍历目标列所有单元格的循环逻辑，仅针对单个单元格做判断
• 语法错误：Cells(ActiveCell.Colum, "O5") 参数顺序颠倒，且Colum拼写错误（应为Column）；xl(Down)不是合法VBA语法，无法实现向下遍历
• 邮件对象创建时机不合理，未在符合条件时按需创建，造成资源浪费

修正后的完整代码 #

Sub SendParticleCountAlert()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim strBody As String
    
    ' 绑定目标工作表，避免使用Select提升运行效率
    Set ws = ThisWorkbook.Sheets("AC01")
    ' 获取O列最后一行有效数据的行号
    lastRow = ws.Cells(ws.Rows.Count, "O").End(xlUp).Row
    
    ' 初始化Outlook应用
    Set OutApp = CreateObject("Outlook.Application")
    
    ' 构建邮件正文
    strBody = "在 " & Format(Date, "yyyy年mm月dd日") & "，检测到某测试站点的0.3微米颗粒数超过ISO 7标准的30000个。" & vbCrLf & vbCrLf & "工作簿链接：" & ThisWorkbook.FullName
    
    ' 遍历O列从第5行开始的所有数据行（假设表头在1-4行）
    For i = 5 To lastRow
        ' 判断条件：O列数值大于30000，且对应行C列日期为当日
        ' 用CLng转换日期为长整型，避免格式差异导致判断失效
        If ws.Cells(i, "O").Value > 30000 And CLng(ws.Cells(i, "C").Value) = CLng(Date) Then
            ' 按需创建邮件对象
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = "你的收件人邮箱"
                .CC = "抄送邮箱"
                .Subject = "颗粒数超标警报"
                .Body = strBody
                .Display ' 测试阶段用Display预览，正式使用可改为.Send自动发送
            End With
            ' 释放邮件对象资源
            Set OutMail = Nothing
        End If
    Next i
    
    ' 释放Outlook应用资源
    Set OutApp = Nothing
End Sub

关键修正说明 #

• 循环遍历逻辑：通过For i = 5 To lastRow遍历O列所有有效数据行，lastRow用End(xlUp)获取，避免遍历空行
• 语法错误修复：修正参数顺序与拼写错误，移除无效的xl(Down)，改用行号循环定位单元格
• 日期判断优化：用CLng()统一转换日期格式，避免因单元格日期显示格式问题导致判断失败
• 代码效率提升：直接绑定工作表对象，取消Select操作，减少内存占用
• 资源管理：每次创建邮件后及时释放对象，避免内存泄漏

注意事项 #

1. 若使用早期绑定，需在VBA编辑器中通过「工具→引用」勾选「Microsoft Outlook xx.x Object Library」；保持CreateObject则无需引用，兼容性更强
2. 测试阶段用.Display预览邮件内容，确认无误后可替换为.Send实现自动发送
3. 工作簿链接通过ThisWorkbook.FullName获取完整路径，确保收件人可直接打开

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