Excel Macro для создания электронных писем работает только при открытии IDE

Я искал ответ на это в течение нескольких недель, и это сводит меня с ума:

У меня есть макрос, который копирует определенные ячейки в новое письмо в Outlook. Он отлично работает, если среда IDE открыта, но обычно, если она не вставляет содержимое в текущий лист вместо нового сообщения электронной почты. Еще страннее то, что иногда он будет работать, пока среда IDE закрыта, но в 99% случаев она не будет, что делает этот кошмар для диагностики.

Это сводит меня с ума, вы, ребята, моя единственная надежда!

Sub EmailReports() Dim rngSubject As Range Dim rngTo As Range Dim rngBody As Range Dim objOutlook As Object Dim objMail As Object Set objOutlook = CreateObject("Outlook.Application") Set objMail = objOutlook.CreateItem(0) xRow = ActiveCell.Row RMName = Sheets("Dashboard").Range("B" & xRow) LastTaskRow = Sheets(RMName).Range("A1") With Target Range("E" & xRow) = Format(Now(), "MM/DD/YYYY") End With Set rngTo = Range("C" & xRow) Set rngSubject = Worksheets("Dashboard").Range("K4") Set rngBody = Worksheets(RMName).Range("D4:E" & LastTaskRow) rngBody.Copy With objMail .To = rngTo .Subject = rngSubject .Display End With SendKeys "^({v})", True Set objOutlook = Nothing Set objMail = Nothing End Sub 

Я попытался добавить предложение Дмитрия, хотя я не уверен, что добавил его правильно.

 Sub EmailReports() Dim rngSubject As Range Dim rngTo As Range Dim rngBody As Range Dim objOutlook As Object Dim objMail As Object Set objOutlook = CreateObject("Outlook.Application") Set objMail = objOutlook.CreateItem(0) xRow = ActiveCell.Row RMName = Sheets("Dashboard").Range("B" & xRow) LastTaskRow = Sheets(RMName).Range("A1") With Target Range("E" & xRow) = Format(Now(), "MM/DD/YYYY") End With Set rngTo = Range("C" & xRow) Set rngSubject = Worksheets("Dashboard").Range("K4") Set rngBody = Worksheets(RMName).Range("D4:E" & LastTaskRow) rngBody.Copy With objMail .To = rngTo .Subject = rngSubject .Display End With Set objHTML = CreateObject("htmlfile") ClipboardText = objHTML.ParentWindow.ClipboardData.GetData("text") objMail.Body = rngBody.Text Set objOutlook = Nothing Set objMail = Nothing End Sub 

Вместо использования SendKeys (который отправит указанный вход в окно переднего плана, каким бы он ни был), вставьте текст, используя

 Set objHTML = CreateObject("htmlfile") ClipboardText = objHTML.ParentWindow.ClipboardData.GetData("text") objMail.Body = ClipboardText 

Или, что еще лучше, вообще не используйте буфер обмена и явно читайте текст текущего выбора в Excel и задайте свойство Body в Outlook:

 objMail.Body = rngBody.Text 

Я наконец-то понял. Дмитрий был на правильном пути, используя HTML-файл вместо простой копии / SendKeys.

Вот новый код:

 Sub EmailReports() Dim rngSubject As Range Dim rngTo As Range Dim rngBody As Range Dim objOutlook As Object Dim objMail As Object Set objOutlook = CreateObject("Outlook.Application") Set objMail = objOutlook.CreateItem(0) xRow = ActiveCell.Row RMName = Sheets("Dashboard").Range("B" & xRow) LastTaskRow = Sheets(RMName).Range("A1") With Target Range("E" & xRow) = Format(Now(), "MM/DD/YYYY") End With Set rngTo = Range("C" & xRow) Set rngSubject = Worksheets("Dashboard").Range("K4") Set rngBody = Worksheets(RMName).Range("D4:E" & LastTaskRow) With objMail .To = rngTo .Subject = rngSubject .HTMLBody = RangetoHTML(rngBody) .Display End With Set objOutlook = Nothing Set objMail = Nothing End Sub 

Он вызывает функцию, которую я нашел на веб-сайте Microsoft под названием «RangetoHTML»:

 Function RangetoHTML(rng As Range) ' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010. Dim fso As Object Dim ts As Object Dim TempFile As String Dim TempWB As Workbook TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" ' Copy the range and create a workbook to receive the data. rng.Copy Set TempWB = Workbooks.Add(1) With TempWB.Sheets(1) .Cells(1).PasteSpecial Paste:=8 .Cells(1).PasteSpecial xlPasteValues, , False, False .Cells(1).PasteSpecial xlPasteFormats, , False, False .Cells(1).Select Application.CutCopyMode = False On Error Resume Next .DrawingObjects.Visible = True .DrawingObjects.Delete On Error GoTo 0 End With ' Publish the sheet to an .htm file. With TempWB.PublishObjects.Add( _ SourceType:=xlSourceRange, _ Filename:=TempFile, _ Sheet:=TempWB.Sheets(1).Name, _ Source:=TempWB.Sheets(1).UsedRange.Address, _ HtmlType:=xlHtmlStatic) .Publish (True) End With ' Read all data from the .htm file into the RangetoHTML subroutine. Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) RangetoHTML = ts.ReadAll ts.Close RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _ "align=left x:publishsource=") ' Close TempWB. TempWB.Close savechanges:=False ' Delete the htm file. Kill TempFile Set ts = Nothing Set fso = Nothing Set TempWB = Nothing End Function 
  • Как экспортировать последние три строки писем в папку из Outlook в Excel?
  • Отправка писем с помощью Outlook 2013 / Excel 2013
  • Как создать соединение / ссылку между Excel и электронной почтой Outlook?
  • Outlook 2010 - странная ошибка.
  • Экспорт электронной почты из папок Outlook в Excel. Проблема с кодированием
  • Копирование Вставка определенных ячеек Excel в автоматическую почтовую почту Outlook
  • Убить места в теле почты Outlook
  • выберите, на какую учетную запись отправить адрес электронной почты Outlook?
  • Код Excel VBA для чтения имени пользователя из ячейки, затем отправьте электронное письмо этому пользователю
  • Outlook для Excel VBA для перезаписывания предыдущих данных
  • Слияние с полем группового ключа из баз данных Excel или SQL
  • Давайте будем гением компьютера.