Блог

Главная - Вопросы по программированию - Отправьте по электронной почте ряд ячеек в качестве вложения

Отправьте по электронной почте ряд ячеек в качестве вложения

#excel #vba #email-attachments

Вопрос:

Я создаю базу данных инвентаризации как относительный новичок с VBA. Я пытался перенастроить «Рона.Сценарии DeBruin VBA» для моей кнопки VBA для копирования, вставки и форматирования диапазона excel в новое почтовое вложение и отправки в ячейку диапазона, построенную с использованием массивов для объединения адресов.

Проблема, с которой я столкнулся, заключается в следующем…. Я создал VBA, который отправит вложение по электронной почте, если в сценарии указано электронное письмо, и я могу отправить электронное письмо с адресами диапазона в массиве, но не с вложениями, но каждый раз, когда я пытаюсь собрать их вместе, я получаю пробелы в электронном письме и никаких вложений.

Вопрос решен — код был отредактирован

 Sub Mail_Range2() 'Working in Excel 2000-2016 'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm  Dim Source As Range  Dim Dest As Workbook  Dim wb As Workbook  Dim TempFilePath As String  Dim TempFileName As String  Dim FileExtStr As String  Dim FileFormatNum As Long  Dim OutApp As Object  Dim OutMail As Object   Set Source = Nothing  On Error Resume Next  Set Source = Range("b4:r39").SpecialCells(xlCellTypeVisible)  On Error GoTo 0   If Source Is Nothing Then  MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly  Exit Sub  End If   With Application  .ScreenUpdating = False  .EnableEvents = False  End With   Set wb = ActiveWorkbook  Set Dest = Workbooks.Add(xlWBATWorksheet)   Source.Copy  With Dest.Sheets(1)  .Cells(1).PasteSpecial Paste:=8  .Cells(1).PasteSpecial Paste:=xlPasteValues  .Cells(1).PasteSpecial Paste:=xlPasteFormats  .Cells(1).Select  Application.CutCopyMode = False  End With   TempFilePath = Environ$("temp") amp; ""  TempFileName = Format(Now, "yy-mm-dd h-mm") amp; " " amp; "Inventory Adjustment "   If Val(Application.Version) lt; 12 Then  'You use Excel 97-2003  FileExtStr = ".xls": FileFormatNum = -4143  Else  'You use Excel 2007-2016  FileExtStr = ".xlsx": FileFormatNum = 51  End If   Set OutApp = CreateObject("Outlook.Application")  Set OutMail = OutApp.CreateItem(0)  With Dest  .SaveAs TempFilePath amp; TempFileName amp; FileExtStr, FileFormat:=FileFormatNum    'Email ranges all located in activeworksheet in same workbook as button  With OutMail  .To = ThisWorkbook.Sheets("Email").Range("B3").value  .CC = ThisWorkbook.Sheets("Email").Range("B4").value  .BCC = ThisWorkbook.Sheets("Email").Range("B5").value  .Subject = ThisWorkbook.Sheets("Email").Range("B6").value  .Body = ThisWorkbook.Sheets("Email").Range("B7").value  .Attachments.Add Dest.FullName  '.Send  .Display  On Error GoTo 0  End With   .Close savechanges:=False  End With   Kill TempFilePath amp; TempFileName amp; FileExtStr   Set OutMail = Nothing  Set OutApp = Nothing   With Application  .ScreenUpdating = True  .EnableEvents = True  End With  MsgBox "Thank you! Email sent.", vbExclamation End Sub

Комментарии:

1. Возможно, удалить On Error Resume Next , чтобы выявить ошибку? Вы должны полностью определить свой диапазон, Sheets("Email").Range("B#") поскольку VBA предполагает, что вы имеете в виду ActiveWorkbook (что выглядит так Dest )

2. Спасибо, ошибка является безусловной ссылкой и подчеркивает .закрыть

3. удалите End With это ниже .Display . Похоже, у тебя есть лишний End With . (Правильный отступ покажет вам это)

4. Спасибо Рэймонду, работающему над углублением. вынул Конец С нижним . Отображение по — прежнему не включает вложения или адреса электронной почты, но подсветка ошибок отсутствует.

5. предполагая, что ваша последняя правка — это то, что у вас есть в настоящее время-вы не удалили On Error Resume Next (я имею в виду приведенную выше With OutMail , и вы также не полностью определили свой диапазон, как указано в моем первом комментарии.

Метки: