Question

寻求将电子邮件发送到人员列表的帮助。我的代码有一个简单的循环，每次都可以通过发送电子邮件的方式获取值。在测试时，第一封电子邮件将始终发送。在那之后，我第二次在“.To”上得到错误

Run-time error - '-2147221238 (8004010a): 该项目已被移动或删除。

这令我感到困惑，因为代码确实准确地抓住了下一个电子邮件值？

电子邮件需要逐个发送，而不是将收件人添加到密件抄送列表中。这可能与VBA有关吗？提前谢谢！

Sub TestingAgain()

'Setting up the Excel variables.
 Dim outApp As Object
Dim outMailItem As Object
Dim iCounter As Integer
Dim sDest As String
Dim sName As String

'Create the Outlook application and the empty email.
Set outApp = CreateObject("Outlook.Application")
Set outMailItem = outApp.CreateItem(0)

With outMailItem
    sDest = ""
For i = 2 To WorksheetFunction.CountA(Columns(1))
    If i <> "" Then
        'Grab first name and email
        sDest = Cells(i, 5).Value
        sName = Cells(i, 1).Value

        'Send each email
        .To = sDest
        .Subject = "FYI"
        .htmlbody = "Some stuff"
        .Send
    Else
    MsgBox ("Error")

    End If
Next i

End With

'Clean up the Outlook application.
Set outMailItem = Nothing
Set outApp = Nothing

End Sub

Answer 1

当您发送电子邮件时，mailItem实例已完成，不再可用。重构您的代码，如：

Sub TestingAgain()

    'Setting up the Excel variables.
     Dim outApp As Object
    Dim outMailItem As Object
    Dim iCounter As Integer
    Dim sDest As String
    Dim sName As String

    'Create the Outlook application and the empty email.
    Set outApp = CreateObject("Outlook.Application")



        sDest = ""
    For i = 2 To WorksheetFunction.CountA(Columns(1))
        If i <> "" Then
        '/ Create the mail item instance.
        Set outMailItem = outApp.CreateItem(0)
        With outMailItem
                'Grab first name and email
                sDest = Cells(i, 5).Value
                sName = Cells(i, 1).Value

                'Send each email
                .To = sDest
                .Subject = "FYI"
                .htmlbody = "Some stuff"
                .send
                '/ Once sent, mail item is no more available.
            End With
            Else
            MsgBox ("Error")

            End If

    Next


    'Clean up the Outlook application.
    Set outMailItem = Nothing
    Set outApp = Nothing
End Sub

电子邮件多个收件人VBA错误

1 个答案: