Как отправить каждый лист на разные адреса электронной почты из Excel?
Если у вас есть книга с несколькими листами, и в ячейке A1 каждого листа есть адрес электронной почты. Теперь вы хотите отправить каждый лист из книги в виде вложения соответствующему получателю в ячейке A1 по отдельности. Как решить эту задачу в Excel? В этой статье я представлю код VBA для отправки каждого листа в виде вложения на другой адрес электронной почты из Excel.
Отправьте каждый лист на разные адреса электронной почты из Excel с кодом VBA
Следующий код VBA может помочь вам отправить каждый лист в виде вложения разным получателям, сделайте следующее:
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 ячейка содержит адрес электронной почты, на который вы хотите отправить электронное письмо. Пожалуйста, измените их в соответствии с вашими потребностями.
- В коде можно указать свои CC, BCC, Subject, Body;
- Чтобы отправить электронное письмо напрямую, не открывая следующее окно нового сообщения, вам нужно изменить .Отображать в .Послать.
3, Затем нажмите F5 ключ для запуска этого кода, и каждый лист автоматически вставляется в окно нового сообщения в виде вложения, см. снимок экрана:
4. Наконец, вам просто нужно нажать Отправить Кнопка для отправки каждого письма по одному.
Лучшие инструменты для офисной работы
Улучшите свои навыки работы с Excel с помощью Kutools for Excel и почувствуйте эффективность, как никогда раньше. Kutools for Excel предлагает более 300 расширенных функций для повышения производительности и экономии времени. Нажмите здесь, чтобы получить функцию, которая вам нужна больше всего...
Вкладка Office: интерфейс с вкладками в Office и упрощение работы
- Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
- Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
- Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!
