用于发送带有附件的电子邮件的VBA循环还包括所有先前迭代的附件

Question

我需要在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对象，每次您输入您的Do时覆盖每个属性…直到循环。但是，由于Attachments是一个集合而不是标量，因此每次执行循环时都要附加一个额外的项。我在外部循环中添加了一个小循环来搜索。item。附件和删除每个附件时。附件。Count大于0。这样，当发送邮件的时候，它应该永远是一张空白的石板。

EDIT: My MailEnvelope对象总是在我发送的第一封邮件之后抛出异常和(-2147467259:自动化错误)。未指定的错误)。不确定你是否看到了这个(似乎没有)。我以前没有使用过这个对象，也不知道它是如何使Outlook自动化的，所以我真的帮不上忙。希望你不会看到它