Question

我尝试了以下代码（我更改了真实的电子邮件地址），它确实在范围内的第一个单元格上工作，但在第一个单元格之后，它给了我一个错误说：“运行时错误，项目已被移动或删除“，然后，它不会发送其他人......我需要在代码中修复什么？

Sub sendMailWithLoop()

    Dim missmatchCell As Range
    Dim Missmatches_Rng As Range
    Dim entityForRepeatedValues_Rng As Range
    Dim OutMail As Object
    Dim OutApp As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    If Range("D1000").End(xlUp).Value <> "Name" Then

        Set Missmatches_Rng = Range(Range("D1000").End(xlUp), Range("D1000").End(xlUp).End(xlUp).Offset(1, 0))

        Missmatches_Rng.Select

        For Each missmatchCell In Selection

            With OutMail    

                .To = "mymail@servername.com"
                .Subject = "Attention !! missmatch found"
                .Body = "The missmatch name is: " & missmatchCell.Offset(0, 1) & ", on: " & missmatchCell
                .Send   

            End With

        Next

    End If

End Sub

thx !!

Answer 1

将Set OutMail = OutApp.CreateItem(0)移到For内：

Sub sendMailWithLoop()

    Dim missmatchCell As Range
    Dim Missmatches_Rng As Range
    Dim entityForRepeatedValues_Rng As Range
    Dim OutMail As Object
    Dim OutApp As Object

    Set OutApp = CreateObject("Outlook.Application")


    If Range("D1000").End(xlUp).Value <> "Name" Then

        Set Missmatches_Rng = Range(Range("D1000").End(xlUp), Range("D1000").End(xlUp).End(xlUp).Offset(1, 0))

        Missmatches_Rng.Select

        For Each missmatchCell In Selection
            Set OutMail = OutApp.CreateItem(olMailItem)
            With OutMail    

                .To = "mymail@servername.com"
                .Subject = "Attention !! missmatch found"
                .Body = "The missmatch name is: " & missmatchCell.Offset(0, 1) & ", on: " & missmatchCell
                .Send   

            End With

        Next

    End If

End Sub

发送多个电子邮件消息VBA

1 个答案: