如何修改VBA宏使其仅遍历Excel筛选后的多行数据完成批量发邮件

核心思路是放弃按固定行号遍历的逻辑，改为直接遍历筛选后的可见行对应的单元格，从单元格属性获取当前行号再取值即可。

修改后的完整代码段 #

Set objOL = CreateObject("Outlook.Application")
objOL.Session.Logon

Set objxls = CreateObject("Excel.Application")
objxls.Workbooks.Open "Email_addresses.xlsx"
objxls.Application.Visible = True

Dim ws As Worksheet
Set ws = objxls.Worksheets("Sheet1")
Set RegionwithData = ws.[a2].CurrentRegion
LastR = RegionwithData(Rows.Count, 1).End(xlUp).Row

Dim visibleRng As Range
' 捕获没有可见行的异常，避免报错
On Error Resume Next
Set visibleRng = ws.Range("A2:A" & LastR).SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Not visibleRng Is Nothing Then
    Dim cl As Range
    For Each cl In visibleRng
        currentRow = cl.Row ' 取可见单元格对应的行号
        Set objmsg = objOL.CreateItemFromTemplate("Template.oft")
     
        With objmsg
            .Display
            .To = ws.Cells(currentRow, 3).Value
            .BCC = ws.Cells(currentRow, 4).Value
            .Subject = ws.Cells(currentRow, 6).Value
            .Send
        End With
        Application.Wait (Now + TimeValue("0:00:01"))
    Next cl
End If

关键改动说明 #

• 新增了visibleRng对象存储A列筛选后的可见单元格，提前加了错误处理逻辑，如果没有符合筛选条件的可见行，代码不会抛出异常直接终止
• 循环逻辑从原来的按行号遍历改为遍历可见单元格，通过单元格的Row属性拿到当前可见行的真实行号，再去取对应列的邮件、主题等信息
• 抽离了worksheet对象声明，避免重复写objxls.Worksheets("Sheet1")，代码更简洁易维护

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