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

问题描述

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

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:

电子邮件 1 - 附件 1

Email 1 - Attachment 1

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

Email 2 - Attachment 1, Attachment 2

电子邮件 3 - 附件 1、附件 2、附件 3；等等.

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.

推荐答案

试试这个:

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 循环时都会覆盖每个属性.但由于 Attachments 是一个集合而不是标量，因此每次遍历循环时都会附加一个附加项.我在外循环中添加了一个小循环，它将搜索 .Item.Attachments 并在 .Attachments.Count 大于 0 时删除每个附件.这样，当需要发送邮件.

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.

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

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屋！