如何正确运行循环批量发送邮件？VBA报错问题求助

• 你只在循环外创建了一个emailItem邮件对象，发送第一封后，这个对象会被Outlook移到已发送文件夹，引用直接失效，后续循环再修改它就会触发“项目已被移动或删除”的错误。
• 原代码里的邮件范围固定成了G10到G15，不符合你“从G10到列尾”的需求。

Sub Email_From_Excel_Basic()
    Dim emailApplication As Object
    Dim emailItem As Object
    Dim cell As Range
    Dim lastRow As Long
    Dim myDataRng As Range

    ' 初始化Outlook应用
    Set emailApplication = CreateObject("Outlook.Application")

    ' 动态获取G列最后一行，设置遍历范围为G10到列尾
    lastRow = Cells(Rows.Count, "G").End(xlUp).Row
    Set myDataRng = Range("G10:G" & lastRow)

    ' 逐个处理邮箱地址
    For Each cell In myDataRng
        ' 每次循环新建一个邮件对象，避免复用已失效的对象
        Set emailItem = emailApplication.CreateItem(0)
        
        With emailItem
            .To = cell.Value
            .Subject = Range("H5").Value
            .Body = Range("J5").Value
            .Send ' 直接发送，要预览的话改成.Display即可
        End With
        
        ' 释放当前邮件对象
        Set emailItem = Nothing
    Next cell

    ' 释放Outlook应用对象
    Set emailApplication = Nothing
End Sub

• 把创建邮件对象的代码Set emailItem = emailApplication.CreateItem(0)移到循环内部，每发一封就新建一个对象，彻底解决对象失效的问题。
• 新增lastRow变量自动获取G列最后一行，实现“从G10到列尾”的批量发送需求。
• 用With语句简化代码结构，让邮件属性设置更直观。
• 每次循环后释放当前邮件对象，避免内存占用。

内容的提问来源于stack exchange，提问作者Jaffet León