How to send each sheet to different email addresses from Excel?
If you have a workbook with several worksheets, and there is an email address in cell A1 of each sheet. Now, you want to send each sheet from the workbook as an attachment to corresponding recipient in cell A1 individually. How could you solve this task in Excel? This article, I will introduce a VBA code to send each sheet as an attachment to different email address from Excel.
Send each sheet to different email addresses from Excel with VBA code
The following VBA code can help you to send each sheet as an attachment to different recipients, please do as this:
1. Press Alt+ F11 keys simultaneously to open the Microsoft Visual Basic for Applications window.
2. Then, click Insert > Module, and copy and paste the below VBA code into the window.
VBA code: Send each sheet as attachment to different email addresses
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 is the cell contains the email address that you want to send the email to. Please change them to your need.
- You can specify the CC, BCC, Subject, Body to your own in the code;
- To send the email directly without opening the following new message window, you need to change .Display to .Send.
3. Then, press F5 key to run this code, and each sheet is inserted into the new message window as an attachment automatically, see screenshot:
4. Finally, you just need to click Send button to send each email one by one.
Best Office Productivity Tools
Supercharge Your Excel Skills with Kutools for Excel, and Experience Efficiency Like Never Before. Kutools for Excel Offers Over 300 Advanced Features to Boost Productivity and Save Time. Click Here to Get The Feature You Need The Most...
Office Tab Brings Tabbed interface to Office, and Make Your Work Much Easier
- Enable tabbed editing and reading in Word, Excel, PowerPoint, Publisher, Access, Visio and Project.
- Open and create multiple documents in new tabs of the same window, rather than in new windows.
- Increases your productivity by 50%, and reduces hundreds of mouse clicks for you every day!
