Question

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

我在使用下面的代码时遇到了困难。除了添加附件外，一切都按预期工作。当我开始循环发送带有各自附件的电子邮件时，它包括所有先前的迭代＆＃39;附件。也就是说电子邮件发送方式如下：

电子邮件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 ... Until循环时都会覆盖每个属性。但由于附件是一个集合而不是标量，因此每次循环时都会追加一个附加项。我在外部循环中添加了一个小循环，它将搜索.Item.Attachments并删除每个附件，同时.Attachments.Count大于0.这样，当发送时，它应该始终是一个空白的平板邮件。

编辑：在我发送的第一封邮件之后，我的MailEnvelope对象将始终抛出异常（-2147467259：自动化错误。未指定错误）。不确定你是否看到了这个（似乎没有）。我之前没有使用过这个对象，也不知道它是如何自动化Outlook的，所以我无法真正提供帮助。希望你不会看到它。

用于发送带附件的电子邮件的VBA循环还包括之前的所有迭代＆＃39;附件

1 个答案: