用附件发送电子邮件的VBA循环也包括所有以前迭代的附件

我需要在电子邮件正文中的工作簿中发送包含一系列单元格的电子邮件，以及Excel 2007中的每个收件人的其他附件。

我有困难与下面的代码。 除了添加附件外，一切都按预期工作。 当我开始循环发送带有各自附件的邮件时，它包含了所有以前的迭代附件。 也就是说电子邮件是这样发送的：

电子邮件1 – 附件1

电子邮件2 – 附件1，附件2

电子邮件3 – 附件1，附件2，附件3; 等等。

Sub Send_Range() Dim x As Integer Dim i As Integer x = Sheets("MarketMacro").Range("M1").Text 'A count of how many emails to send. i = 2 Do ' Select the range of cells on the active worksheet. Sheets("Summary").Range("A1:M77").Select ' Show the envelope on the ActiveWorkbook. ActiveWorkbook.EnvelopeVisible = True With ActiveSheet.MailEnvelope .Introduction = "This is a sample worksheet." .Item.To = Sheets("MarketMacro").Range("A" & i).Text .Item.Subject = "Test" 'email subject .Item.attachments.Add (Sheets("MarketMacro").Range("H" & i).Text) 'add attachment based on path in worksheet cell .Item.Send 'sends without displaying the email End With i = i + 1 Loop Until i = x + 2 MsgBox ("The tool sent " & i - 2 & " reports.") End Sub 

有没有人有解决这个问题？ 我有另一种方式来发送电子邮件与附件的程序完美的工作，但我不能发送作为正文电子邮件的一系列单元格。

Answer 1

尝试这个：

 Sub Send_Range() Dim x As Integer Dim i As Integer x = Sheets("MarketMacro").Range("M1").Text 'A count of how many emails to send. i = 2 Do ' Select the range of cells on the active worksheet. Sheets("Summary").Range("A1:M77").Select ' Show the envelope on the ActiveWorkbook. ActiveWorkbook.EnvelopeVisible = True With ActiveSheet.MailEnvelope 'Before we send emails, we will loop through the Attachments collection 'and delete any that are in there already. 'There seemed to be an issue with the For...Each construct which 'would not delete all the attachments. This is the only way I could 'do it. Do Until .Item.attachments.Count = 0 .Item.attachments(1).Delete Loop .Introduction = "This is a sample worksheet." .Item.To = Sheets("MarketMacro").Range("A" & i).Text .Item.Subject = "Test" 'email subject .Item.attachments.Add (Sheets("MarketMacro").Range("H" & i).Text) 'add attachment based on path in worksheet cell .Item.Send 'sends without displaying the email End With i = i + 1 Loop Until i = x + 2 MsgBox ("The tool sent " & i - 2 & " reports.") End Sub 

我相信代码只是重复使用相同的MailEnvelope对象，每次inputDo … Until循环时都会覆盖每个属性。 但是因为附件是一个集合，而不是标量，所以每当你经过这个循环时，你都会附加一个附加的项目。 我已经在外部循环中添加了一个小循环，将通过.Item.Attachmentssearch并删除每个附件，而.Attachments.Count大于0.这样，它应该始终是一个空白的石板时，发送邮件。

编辑：我的邮件信封对象将始终引发我发送的第一个邮件和（-2147467259：自动化错误。未指定的错误）后的exception。 不知道你是否看到这个（似乎不是）。 我之前没有玩过这个对象，也不知道它是如何自动化Outlook的，所以我不能真正帮助。 希望你不会看到它。