Как да изпратите всеки лист до различни имейл адреси от 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 за Excel и изпитайте ефективност, както никога досега. Kutools за Excel предлага над 300 разширени функции за повишаване на производителността и спестяване на време. Щракнете тук, за да получите функцията, от която се нуждаете най-много...
Раздел Office Внася интерфейс с раздели в Office и прави работата ви много по-лесна
- Разрешете редактиране и четене с раздели в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
- Отваряйте и създавайте множество документи в нови раздели на един и същ прозорец, а не в нови прозорци.
- Увеличава вашата производителност с 50% и намалява стотици кликвания на мишката за вас всеки ден!
