Блог

Мне нужно отправить электронное письмо с диапазоном ячеек из рабочей книги в теле письма, а также с другим приложением для каждого получателя в 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" amp; i).Text
      .Item.Subject = "Test" 'email subject
      .Item.attachments.Add (Sheets("MarketMacro").Range("H" amp; 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 " amp; i - 2 amp; " reports.")
End Sub
  

У кого-нибудь есть решение этой проблемы? У меня есть другой способ программной отправки электронных писем с вложениями, который отлично работает, но я не могу отправить диапазон ячеек в качестве тела электронного письма.

Попробуйте это:

 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" amp; i).Text
      .Item.Subject = "Test" 'email subject
      .Item.attachments.Add (Sheets("MarketMacro").Range("H" amp; 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 " amp; i - 2 amp; " reports.")
End Sub
  

Я полагаю, что код просто повторно использует один и тот же объект MailEnvelope, перезаписывая каждое свойство каждый раз, когда вы вводите свой цикл Do … Until. Но поскольку вложения — это коллекция, а не скаляр, вы добавляете один дополнительный элемент каждый раз, когда проходите цикл. Я добавил небольшой цикл внутри этого внешнего цикла, который будет выполнять поиск по .Item .Вложения и удаление каждого вложения во время.Вложения.Количество больше 0. Таким образом, когда приходит время отправлять почту, всегда должен быть чистый лист.

РЕДАКТИРОВАТЬ: мой объект MailEnvelope всегда будет выдавать исключение после первого отправленного мной письма и (-2147467259: ошибка автоматизации. Неопределенная ошибка ). Не уверен, видите ли вы это (кажется, нет). Я раньше не играл с этим объектом и не знаю, как он автоматизирует Outlook, поэтому я действительно не могу помочь. Надеюсь, вы просто не увидите этого.