用附件发送电子邮件的VBA循环还包括所有以前的迭代附件 [英] VBA loop to send emails with attachments also includes all previous iterations' attachments

问题描述

我需要在电子邮件正文中的工作簿中发送一系列单元格的电子邮件，并为每个收件人提供不同的电子邮件。 p>我在下面的代码中遇到困难。除了添加附件之外，一切都按照预期进行。当我开始循环发送电子邮件与他们各自的附件，它包括所有以前的迭代的附件。也就是说电子邮件发送如下：

电子邮件1 - 附件1

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

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

  Sub Send_Range（）
 Dim x As Integer 
 Dim i As Integer 
x = Sheets （MarketMacro）。范围（M1）。文本'要发送的电子邮件数量。 
 i = 2 
 Do 
'选择活动工作表上的单元格范围。 
表格（摘要）范围（A1：M77）。选择
'在ActiveWorkbook上显示信封。 
 ActiveWorkbook.EnvelopeVisible = True 
 
使用ActiveSheet.MailEnvelope 
 .Introduction =这是一个示例工作表。 
 .Item.To = Sheets（MarketMacro）。Range（A& i）.Text 
 .Item.Subject =Test'email subject 
 .Item.attachments .Add（Sheets（MarketMacro）。Range（H& i）.Text）'根据工作表单元格中的路径添加附件
 .Item.Send'发送而不显示电子邮件
结束
i = i + 1 
循环直到i = x + 2 
 MsgBox（发送的工具& i  -  2&报告）
 End Sub 
  

有没有人可以解决这个问题？我有另一种方式通过编程方式发送电子邮件，附件工作完美，但我无法发送一系列单元格作为电子邮件的正文。

解决方案

尝试这样：

  Sub Send_Range（）
 Dim x As Integer 
 Dim i As Integer 
 
x = Sheets（MarketMacro）。Range（M1）。Text'要发送的电子邮件数量。 
 i = 2 
 
 Do 
'选择活动工作表上的单元格范围。 
表格（摘要）范围（A1：M77）。选择
'在ActiveWorkbook上显示信封。 
 ActiveWorkbook.EnvelopeVisible = True 
 
使用ActiveSheet.MailEnvelope 
'在发送电子邮件之前，我们将循环遍历附件集合
'并删除其中的任何内容已经。 
'似乎有一个问题For ...每个构造，
'不会删除所有的附件。这是我能够
'做的唯一方法。 
 Do Until .Item.attachments.Count = 0 
 .Item.attachments（1）.Delete 
循环
 
 .Introduction =这是一个示例工作表。  
 .Item.To = Sheets（MarketMacro）。Range（A& i）.Text 
 .Item.Subject =Test'email subject 
 .Item.attachments .Add（Sheets（MarketMacro）。Range（H& i）.Text）'根据工作表单元格中的路径添加附件
 .Item.Send'发送而不显示电子邮件
结束
i = i + 1 
循环直到i = x + 2 
 MsgBox（发送的工具& i  -  2&报告）
 End Sub 
  

我相信代码只是重用相同的MailEnvelope对象，每次输入你的Do时覆盖每个属性。 ..循环。但是由于附件是一个集合而不是标量，因此您每次通过循环都附加一个附加项目。我在该外部循环中添加了一个小循环，它将搜索.Item.Attachments并删除每个附件，而.Attachments.Count大于0.这样，当它发送时，它应该始终是空白的邮件。

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

I need to send an email with a range of cells from a workbook in the body of the email, and also a different attachent for each recipient, in Excel 2007.

I am having difficulty with the code below. Everything works as intended except for adding the attachments. When I start the loop to send the emails with their respective attachments, it includes all the previous iterations' attachments. That is to say the emails send like this:

Email 1 - Attachment 1

Email 2 - Attachment 1, Attachment 2

Email 3 - Attachment 1, Attachment 2, Attachment 3; and so on.

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

Does anyone have a solution to this problem? I have another way to send the emails programmatically with attachments that works perfectly fine, but I am unable to send a range of cells as the body the email.

解决方案

Try this:

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

I believe the code is just reusing the same MailEnvelope object, overwriting each property each time you enter your Do...Until loop. But since Attachments is a collection and not a scalar, you are appending one additional item every time you go through the loop. I've added a small loop within that outer loop that will search through .Item.Attachments and delete each attachment while .Attachments.Count is greater than 0. That way, it should always be a blank slate when it comes time to send the mail.

EDIT: My MailEnvelope object would always throw an exception after the first mail I sent and (-2147467259: Automation error. Unspecified error ). Not sure if you are seeing this (seems not). I have not played with this object before and don't know how it's automating Outlook, so I can't really help. Hopefully you just won't see it.

这篇关于用附件发送电子邮件的VBA循环还包括所有以前的迭代附件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！