Как отправить каждый лист на разные адреса электронной почты из Excel?
Если у вас есть книга Excel с несколькими листами, и на каждом из них в ячейке S1 указан адрес электронной почты, вы, вероятно, захотите отправить каждый лист как отдельное вложение соответствующему получателю. Выполнять эту задачу вручную может быть утомительно — особенно если листов много. В этом руководстве мы покажем, как с помощью кода VBA автоматически отправлять каждый лист из книги Excel как вложение на адрес электронной почты, указанный в ячейке S1 этого листа.
Отправка каждого листа разным Адрес электронной почты из Excel с помощью кода VBA
Приведённый ниже код VBA позволяет отправлять каждый лист в виде вложения получателю, указанному в ячейке S1. Выполните следующие шаги:
1. Нажмите Alt+F11 одновременно, чтобы открыть окно Microsoft Visual Basic для приложений.
2. Затем выберите Вставка > Модуль и скопируйте приведённый ниже код VBA в открывшееся окно.
Код VBA: отправка каждого листа как вложения разным Адрес электронной почты
Sub Mail_Every_Worksheet()
'Updateby ExtendOffice
Dim xWs As Worksheet
Dim xWb As Workbook
Dim xFileExt As String
Dim xFileFormatNum As Long
Dim xTempFilePath As String
Dim xFileName As String
Dim xOlApp As Object
Dim xMailObj As Object
On Error Resume Next
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
xTempFilePath = Environ$("temp") & "\"
If Val(Application.Version) < 12 Then
xFileExt = ".xls": xFileFormatNum = -4143
Else
xFileExt = ".xlsm": xFileFormatNum = 52
End If
Set xOlApp = CreateObject("Outlook.Application")
For Each xWs In ThisWorkbook.Worksheets
If xWs.Range("S1").Value Like "?*@?*.?*" Then
xWs.Copy
Set xWb = ActiveWorkbook
xFileName = xWs.Name & " of " _
& VBA.Left(ThisWorkbook.Name, VBA.InStr(ThisWorkbook.Name, ".") - 1) & " "
Set xMailObj = xOlApp.CreateItem(0)
xWb.Sheets.Item(1).Range("S1").Value = ""
With xWb
.SaveAs xTempFilePath & xFileName & xFileExt, FileFormat:=xFileFormatNum
With xMailObj
'specify the CC, BCC, Subject, Body below
.To = xWs.Range("S1").Value
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add xWb.FullName
.Display
End With
.Close SaveChanges:=False
End With
Set xMailObj = Nothing
Kill xTempFilePath & xFileName & xFileExt
End If
Next
Set xOlApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
- S1 — это ячейка, содержащая адрес электронной почты, на который вы хотите отправить письмо. Если ваши адреса электронной почты находятся в другой ячейке, например A1, вы можете изменить код, чтобы отразить это изменение.
- Вы можете указать поля «Копия» (CC), «Скрытая копия» (BCC), тему и текст письма по своему усмотрению в коде;
- Чтобы отправить письмо сразу, не открывая новое окно сообщения, замените .Display на .Send.
3. Затем нажмите F5, чтобы запустить этот код. Каждый лист автоматически добавится как вложение в новое окно сообщения (см. снимок экрана):
4. Наконец, нажмите кнопку Отправить, чтобы отправлять письма одно за другим.
Kutools для Excel: Отправляйте персонализированные письма легко и всего в один клик!
Устали отправлять клиентские письма по одному? С функцией «Отправка писем» от Kutools для Excel общение станет быстрее и профессиональнее! Просто подготовьте таблицу Excel с именами, адресами электронной почты, регистрационными кодами и вставьте заполнитель — система автоматически создаст персонализированные письма и отправит сотни из них всего одним щелчком мыши. Больше никакой рутины!
- 💡 Динамические заполнители (например, имя или регистрационный код) автоматически подставляют персонализированное содержимое для каждого получателя, делая каждое письмо по-настоящему уникальным и созданным специально для него.
- 📎 Прикрепляйте персонализированные файлы для точной доставки
- 📤 Бесшовная интеграция с Outlook обеспечивает безопасную и надёжную отправку
- 📝 Сохраняйте и повторно используйте шаблоны писем для максимальной эффективности
- 🎨 Редактор WYSIWYG («что видишь, то и получаешь»), простой в использовании
- 🖋 Использует вашу подпись из Outlook — никаких дополнительных настроек, просто нажмите «Отправить»!
- Получите Kutools для Excel уже сегодня!
Лучшие инструменты повышения продуктивности в Office
Раскройте весь потенциал Excel с помощью Kutools для Excel и ощутите эффективность как никогда раньше.Kutools для Excel предлагает более 300 расширенных функций для повышения продуктивности и Экономия времени.Нажмите здесь, чтобы получить нужную Вам функцию…
Office Tab добавляет в Office вкладки и значительно упрощает Вашу работу
- Включите редактирование и чтение во вкладках в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
- Открывайте и создавайте несколько документов во вкладках одного окна — вместо того чтобы использовать отдельные окна.
- Повышает вашу продуктивность на 50 % и экономит сотни кликов мышью каждый день!
Все надстройки Kutools — один установщик
Kutools for Office — набор надстроек для Excel, Word, Outlook и PowerPoint, а также Office Tab Pro, идеально подходящий командам, работающим с разными приложениями Office.
- Единый комплект— надстройки для Excel, Word, Outlook и PowerPoint + Office Tab Pro
- Один установщик, одна лицензия— настройка занимает считанные минуты (готово для MSI)
- Лучше работать вместе— оптимизированная продуктивность во всех приложениях Office
- 30-дневная полнофункциональная пробная версия— без регистрации и кредитной карты
- Лучшее соотношение цены и качества— экономия по сравнению с покупкой отдельных надстроек