Як надіслати кожен аркуш на різні адреси електронної пошти з Excel?
Якщо у вас є книга з кількома робочими аркушами, і в комірці A1 кожного аркуша є адреса електронної пошти. Тепер ви хочете надіслати кожен аркуш із робочої книги як вкладення відповідному одержувачу в клітинці A1 окремо. Як можна було вирішити це завдання в Excel? У цій статті я познайомлю код VBA для надсилання кожного аркуша як вкладення на іншу адресу електронної пошти з Excel.
Надішліть кожен аркуш на різні адреси електронної пошти з Excel із кодом VBA
Наступний код VBA може допомогти вам надіслати кожен аркуш як вкладення різним одержувачам. Будь ласка, виконайте наступне:
1. Прес Alt + F11 клавіші одночасно, щоб відкрити Microsoft Visual Basic для додатків вікна.
2. Потім натисніть кнопку Insert > Модулі, скопіюйте та вставте наведений нижче код 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 для Excel і відчуйте ефективність, як ніколи раніше. Kutools для Excel пропонує понад 300 додаткових функцій для підвищення продуктивності та економії часу. Натисніть тут, щоб отримати функцію, яка вам найбільше потрібна...
Вкладка Office Передає інтерфейс із вкладками в Office і значно полегшує вашу роботу
- Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
- Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
- Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!
