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

寻求帮助发送电子邮件的人的名单。 我的代码有一个简单的循环，并在每次发送电子邮件的位置抓取值。 在testing的时候，第一封电子邮件总是会被发送。 之后，第二次通过我的错误“.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