Excel 教程 – 从 Excel发送电子邮件
通常我们会使用 Outlook、Gmail 等邮件客户端发送邮件。但很多用户会在 Excel 工作簿中存储数据，并在处理数据时需要将部分内容发送给他人。因此，直接从 Excel 工作簿发送邮件可以节省切换到邮件客户端的时间。本教程将通过分步讲解，帮助你在不同场景下从 Excel发送邮件。
注意：在使用以下方法前，请确保你的电脑已配置好 Outlook 邮件客户端，并将其设置为默认邮件客户端。
目录：[ 隐藏 ]
1. 从 Excel发送电子邮件的基础知识
本节将介绍从 Excel发送电子邮件的基础操作。
1.1 使用 Excel 内置功能从 Excel发送电子邮件
如果你只需从 Excel发送简单邮件，仅包含收件人、主题、抄送和正文字段，Excel 的内置功能即可满足需求。
如下面表格所示，若需根据不同字段从 Excel发送不同邮件，可以利用这些字段的单元格引用，创建不同的 Hyperlink公式来实现。创建好邮件超链接后，点击所需超链接即可自动生成邮件。
注意：如果“收件人”或“抄送”字段中有多个地址，请用分号分隔。
本节分为四部分，分别演示如何将邮箱地址、抄送收件人、主题和正文内容分别添加到 Hyperlink公式中。请按以下步骤操作。
“HYPERLINK”函数的语法和参数如下。
语法
HYPERLINK(link_location, [friendly_name])
参数说明
这里我们在公式中使用“mailto:”来添加收件人邮箱。例如，第一个收件人的邮箱在单元格 B2，因此需添加“mailto:”并引用 B2。
“mailto:”&B2
1.选择一个用于显示超链接的单元格，本例选择 F2。
2. 然后在该单元格输入如下公式。
=HYPERLINK("mailto:"&B2)
注意：按下“Enter”键后，会生成一个如图所示的超链接。点击该链接时，将自动创建一封 Outlook 邮件，并自动填充收件人邮箱地址。
收件人邮箱地址已添加到 Hyperlink公式中。请继续以下步骤，根据需要添加主题、抄送收件人和正文内容。
1.1.1.2 在 Hyperlink公式中添加抄送（Cc）收件人
要在 Hyperlink 函数中添加抄送收件人，请在公式中添加“?cc=”，如下所示。
F2 单元格中的公式应如下所示：
=HYPERLINK("mailto:" & B2 & "?cc=" & C2)
要在 Hyperlink 函数中添加主题，请在公式中添加“&subject=”，如下所示。
F2 单元格中的公式现在应如下所示：
=HYPERLINK("mailto:" & B2 & "?cc=" & C2 & "&subject="& D2)
1.1.1.4 在 Hyperlink公式中添加带换行的正文内容
最后一步是将正文内容添加到 Hyperlink公式。如示例所示，E2 中的两行文本用换行符分隔，你希望邮件正文中也保留换行。那么 Outlook 能否识别换行符？我们来验证一下。
要将正文内容添加到 Hyperlink公式，需要在公式中添加“&body=”，如下所示。
F2 单元格中的公式现在如下所示：
=HYPERLINK("mailto:" & B2 & "?cc=" & C2 & "&subject="& D2 & "&body="& E2)
注意：按下“Enter”键并点击链接后，你会发现新邮件中的正文内容显示在同一行。
如需将邮件正文分行显示，需要在单元格内容中插入回车符代码“%0A”，在需要换行的位置添加即可。见下图：
在上述步骤中，我们已完成 Link_location 参数的邮件字段设置。本节将介绍如何设置下一个参数 [friendly_name]。
本例中，我希望超链接单元格显示为“Email to xx”，其中 xx 为收件人姓名（A2）。因此，F2 单元格中的公式应修改为：
=HYPERLINK("mailto:" & B2 & "?cc=" & C2 & "&subject="& D2 & "&body="& E2, "Email to "&A2)按下“Enter”键即可得到结果。
选中该公式单元格，向下拖动“自动填充柄”以批量生成其他邮件超链接。见下图：
1.1.2 使用 Hyperlink 函数从 Excel发送电子邮件
除了使用上述 Hyperlink公式外，你还可以通过 Excel 的“插入超链接”功能手动创建邮件超链接。本节将介绍具体步骤。
1.右键点击需要插入超链接的邮箱，选择右键菜单中的“链接”。
2. 在弹出的“插入超链接”对话框中，按如下方式配置。
点击超链接后，将自动创建一封 Outlook 邮件，并按指定的收件人、主题和正文内容填充。见下图：
注意事项：
1.2 使用 VBA 脚本向单元格中的多个收件人发送邮件
如上例所示，单元格中有多个邮箱地址，用分号分隔。如果你有如下图所示的邮箱地址列表，并希望向所有人发送一封邮件或分别发送邮件，可使用以下 VBA代码实现。
1.2.1 使用 VBA 脚本向单元格中的多个收件人发送一封邮件
1. 在包含所有目标邮箱地址的工作表中，按下“Alt” + “F11”打开“Microsoft Visual Basic for Applications”窗口。
2. 在“Microsoft Visual Basic for Applications”窗口中，点击“插入”>“模块”，然后将以下代码粘贴到“模块（代码）”窗口。
VBA代码：向邮箱地址列表发送邮件
Sub sendmultiple()
'updateby Extendoffice 20220802
Dim xOTApp As Object
Dim xMItem As Object
Dim xCell As Range
Dim xRg As Range
Dim xEmailAddr As String
Dim xTxt As String
On Error Resume Next
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Please select the addresses list:", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
Set xOTApp = CreateObject("Outlook.Application")
For Each xCell In xRg
If xCell.Value Like "*@*" Then
If xEmailAddr = "" Then
xEmailAddr = xCell.Value
Else
xEmailAddr = xEmailAddr & ";" & xCell.Value
End If
End If
Next
Set xMItem = xOTApp.CreateItem(0)
With xMItem
.To = xEmailAddr
.Subject = "Test"
.Body = "Dear " _
& vbNewLine & vbNewLine & _
"This is a test email " & _
"sending in Excel"
.Display
End With
End Sub3. 按下“F5”运行代码，会弹出“Kutools for Excel”对话框。选择邮箱地址列表后点击“确定”。
注意事项：
.Body = "Dear " _
& vbNewLine & vbNewLine & _
"This is a test email " & _
"sending in Excel"运行代码后，所选区域内的所有邮箱地址将显示在邮件窗口的收件人字段中。见下图：
1.2.2 使用 VBA 脚本分别向单元格中列出的每个收件人发送邮件
上述代码会将所选区域内所有邮箱地址添加到邮件窗口的收件人字段。如果你希望分别向每个邮箱地址单独发送邮件，且彼此不可见对方邮箱，可尝试以下 VBA 脚本。
1. 在包含所有目标邮箱地址的工作表中，按下“Alt” + “F11”打开“Microsoft Visual Basic for Applications”窗口。
2. 在“Microsoft Visual Basic for Applications”窗口中，点击“插入”>“模块”，然后将以下代码粘贴到模块（代码）窗口。
VBA代码：分别向单元格中列出的每个邮箱地址发送邮件
Sub SendEmailToAddressInCells()
'Updated by Extendoffice 20220802
Dim xRg As Range
Dim xRgEach As Range
Dim xRgVal As String
Dim xAddress As String
Dim xOutApp As Outlook.Application
Dim xMailOut As Outlook.MailItem
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Please select the addresses list", "KuTools For Excel", xAddress, , , , , 8)
If xRg Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xOutApp = CreateObject("Outlook.Application")
Set xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues)
For Each xRgEach In xRg
xRgVal = xRgEach.Value
If xRgVal Like "?*@?*.?*" Then
Set xMailOut = xOutApp.CreateItem(olMailItem)
With xMailOut
.To = xRgVal
.Subject = "Test"
.Body = "Dear " _
& vbNewLine & vbNewLine & _
"This is a test email " & _
"sending in Excel"
.Display
'.Send
End With
End If
Next
Set xMailOut = Nothing
Set xOutApp = Nothing
Application.ScreenUpdating = True
End Sub3. 然后点击“工具”>“引用”，在“引用 – VBAProject”对话框中，找到并勾选“Microsoft Outlook16.0 Object Library”，点击“确定”保存。
4. 按下“F5”运行代码，会弹出“Kutools for Excel”对话框。选择邮箱地址列表后点击“确定”。
注意事项：
.Subject = "Test"
.Body = "Dear " _
& vbNewLine & vbNewLine & _
"This is a test email " & _
"sending in Excel"本例中，所选区域有六个邮箱地址，因此会自动创建六个 Outlook 邮件窗口，每个窗口的收件人字段分别为不同邮箱。见下图：
5. 最后，点击“发送”按钮，逐一发送邮件。
2. 使用 VBA 脚本在 Excel发送的邮件中插入附件或 Outlook 签名
本节将介绍如何在 Excel发送的邮件中插入附件或 Outlook 默认签名。
2.1 在 Excel发送的邮件中插入附件
本节将介绍不同场景下插入附件的方法，你可根据实际需求选择。点击以下任一链接可跳转到对应方法：
你可以使用以下 VBA代码，将文件夹中的一个或多个文件作为附件从 Excel发送邮件。
1. 按下“Alt” + “F11”键。
2. 在打开的“Microsoft Visual Basic for Applications”窗口中，点击“插入”>“模块”。然后将以下 VBA代码粘贴到模块（代码）窗口。
VBA代码：将文件夹中的文件作为附件从 Excel发送邮件
Sub EmailWithAttachments()
'Updated by Extendoffice 20220802
Dim xStrFile As String
Dim xFilePath As String
Dim xFileDlg As FileDialog
Dim xFileDlgItem As Variant
Dim xOutApp As Outlook.Application
Dim xMailOut As Outlook.MailItem
Application.ScreenUpdating = False
Set xOutApp = CreateObject("Outlook.Application")
Set xMailOut = xOutApp.CreateItem(olMailItem)
Set xFileDlg = Application.FileDialog(msoFileDialogFilePicker)
If xFileDlg.Show = -1 Then
With xMailOut
.BodyFormat = olFormatRichText
.To = "xxx@aaa.com"
.Subject = "test"
.HTMLBody = "test"
For Each xFileDlgItem In xFileDlg.SelectedItems
.Attachments.Add xFileDlgItem
Next xFileDlgItem
.Display
End With
End If
Set xMailOut = Nothing
Set xOutApp = Nothing
Application.ScreenUpdating = True
End Sub注意事项：
3. 然后点击“工具”>“引用”，在“引用 – VBAProject”对话框中，找到并勾选“Microsoft Outlook16.0 Object Library”，点击“确定”保存。
4. 按下“F5”运行代码，会弹出“浏览”窗口，请选择需要作为附件发送的文件，然后点击“确定”。
随后会弹出邮件窗口，你会看到所选文件已作为附件显示在“附件”栏。
如需将当前工作表作为附件从 Excel发送邮件，可使用本节的 VBA 脚本。
1. 按下“Alt” + “F11”键。
2. 在打开的“Microsoft Visual Basic for Applications”窗口中，点击“插入”>“模块”。然后将以下 VBA代码粘贴到“模块（代码）”窗口。
VBA代码：将当前工作表作为附件发送邮件
Sub SendWorkSheet()
'Update by Extendoffice 20220802
Dim xFile As String
Dim xFormat As Long
Dim Wb As Workbook
Dim Wb2 As Workbook
Dim FilePath As String
Dim FileName As String
Dim OutlookApp As Object
Dim OutlookMail As Object
On Error Resume Next
Application.ScreenUpdating = False
Set Wb = Application.ActiveWorkbook
ActiveSheet.Copy
Set Wb2 = Application.ActiveWorkbook
Select Case Wb.FileFormat
Case xlOpenXMLWorkbook:
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
Case xlOpenXMLWorkbookMacroEnabled:
If Wb2.HasVBProject Then
xFile = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
Else
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
End If
Case Excel8:
xFile = ".xls"
xFormat = Excel8
Case xlExcel12:
xFile = ".xlsb"
xFormat = xlExcel12
End Select
FilePath = Environ$("temp") & "\"
FileName = Wb.Name & Format(Now, "dd-mmm-yy h-mm-ss")
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
With OutlookMail
.To = "xxx@aaa.com"
.CC = "Email Address"
.BCC = "Email Address"
.Subject = "kte features"
.Body = "Please check and read this document."
.Attachments.Add Wb2.FullName
.Display
'.Send
End With
Wb2.Close
Kill FilePath & FileName & xFile
Set OutlookMail = Nothing
Set OutlookApp = Nothing
Application.ScreenUpdating = True
End Sub注意事项：
3. 按下“F5”运行代码，当前工作表将被保存为 Excel 工作簿，并自动作为附件插入到邮件窗口。见下图：
注意：附件工作簿（仅包含当前工作表）名称与原工作簿相同，并在文件名中添加了运行代码的时间。
在学习了将当前工作表作为附件发送的 VBA代码后，这里提供另一段 VBA 脚本，帮助你将整个工作簿作为附件发送。请按以下步骤操作。
1. 按下“Alt” + “F11”键。
2. 在打开的“Microsoft Visual Basic for Applications”窗口中，点击“插入”>“模块”。然后将以下 VBA代码粘贴到模块（代码）窗口。
VBA代码：将当前工作簿作为附件从 Excel发送邮件
Sub SendWorkBook()
'Update by Extendoffice 20220802
Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
On Error Resume Next
With OutlookMail
.To = "xxx@aaa.com"
.CC = "Email Address"
.BCC = "Email Address"
.Subject = "kte feature"
.Body = "Hello, please check and read this document, thank you."
.Attachments.Add Application.ActiveWorkbook.FullName
.Display
'.Send
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub注意事项：
3. 按下“F5”运行代码，当前工作簿将自动作为附件插入到邮件窗口。见下图：
大多数情况下，用户会将 Excel 工作簿另存为 PDF 文件后再作为附件发送。本节将介绍如何直接从 Excel发送当前打开的工作簿为 PDF 附件，无需手动另存为 PDF。
1. 按下“Alt” + “F11”键。
2. 在打开的“Microsoft Visual Basic for Applications”窗口中，点击“插入”>“模块”。然后将以下 VBA代码粘贴到模块（代码）窗口。
VBA代码：将整个工作簿以 PDF形式作为附件发送邮件
Sub SendWorkBookAsPDF()
'Update 20220803
Dim Wb As Workbook
Dim FilePath As String
Dim FileName As String
Dim xOutApp As Object
Dim xOutMail As Object
On Error Resume Next
Application.ScreenUpdating = False
Set Wb = Application.ActiveWorkbook
FileName = Left(Wb.Name, (InStrRev(Wb.Name, ".", -1, vbTextCompare) - 1)) & Format(Now, "dd-mmm-yy h-mm-ss") & ".pdf"
FilePath = Environ$("temp") & "\" & FileName
Wb.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
FilePath, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
With xOutMail
.To = "xxx@aaa.com"
.CC = "Email Address"
.BCC = "Email Address"
.Subject = "test"
.Body = "test"
.Attachments.Add FilePath
.Display 'or use .Send
End With
Kill FilePath
Set xOutMail = Nothing
Set xOutApp = Nothing
Application.ScreenUpdating = True
End Sub注意事项：
3. 按下“F5”运行代码，当前工作簿将自动作为 PDF 附件插入到新邮件窗口。见下图：
例如，有一个名为“Monthly sales”的工作簿，你已在名为“sales report”的工作表中完成销售报表，并希望将该工作表以 PDF 文件形式发送给同事。可使用以下 VBA代码实现。
1. 按下“Alt” + “F11”键。
2. 在打开的“Microsoft Visual Basic for Applications”窗口中，点击“插入”>“模块”。然后将以下 VBA代码粘贴到模块（代码）窗口。
VBA代码：将当前工作表以 PDF形式作为附件发送邮件
Sub SendWorkSheetToPDF()
'Update by Extendoffice 20220803
Dim Wb As Workbook
Dim FileName As String
Dim OutlookApp As Object
Dim OutlookMail As Object
On Error Resume Next
Set Wb = Application.ActiveWorkbook
FileName = Wb.FullName
xIndex = VBA.InStrRev(FileName, ".")
If xIndex > 1 Then FileName = VBA.Left(FileName, xIndex - 1)
FileName = FileName & "_" + ActiveSheet.Name & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FileName
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = "xxx@aaa.com"
.CC = "Email Address"
.BCC = "Email Address"
.Subject = "test"
.Body = "test"
.Attachments.Add FileName
.Display
'.Send
End With
Kill FileName
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub注意事项：
3. 按下“F5”运行代码，当前工作表将自动作为 PDF 附件插入到新邮件窗口。见下图：
2.2 在 Excel发送的邮件中插入 Outlook 签名
以上述案例为例，你通过 VBA代码将当前工作表作为 PDF 附件发送，但 Outlook 签名无法自动添加到邮件窗口。若需在从 Excel发送的邮件中保留 Outlook 默认签名，可参考以下方法。
以下列出两段 VBA代码。
VBA代码1：用于保留 Outlook 签名。
VBA代码2：用于将当前工作表作为 PDF 附件发送邮件。
VBA代码1：保留 Outlook 签名
.HTMLBody = "Email body" & "
" & .HTMLBodyVBA代码2：将当前工作表作为 PDF 附件发送邮件
Sub SendWorkSheetToPDF()
'Update by Extendoffice 20220803
Dim Wb As Workbook
Dim FileName As String
Dim OutlookApp As Object
Dim OutlookMail As Object
On Error Resume Next
Set Wb = Application.ActiveWorkbook
FileName = Wb.FullName
xIndex = VBA.InStrRev(FileName, ".")
If xIndex > 1 Then FileName = VBA.Left(FileName, xIndex - 1)
FileName = FileName & "_" + ActiveSheet.Name & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FileName
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = "xxx@aaa.com"
.CC = "Email Address"
.BCC = "Email Address"
.Subject = "test"
.Body = "test"
.Attachments.Add FileName
.Display
'.Send
End With
Kill FileName
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub1. 通常需按下“Alt” + “F11”打开“Microsoft Visual Basic for Applications”窗口。
2. 在“Microsoft Visual Basic for Applications”窗口中，点击“插入”>“模块”，将上述 VBA代码2 粘贴到模块（代码）窗口。
3. 若需在从 Excel发送的邮件中保留 Outlook 默认签名，请按如下方式修改 VBA代码2：
以下为修改后的完整代码。
Sub SendWorkSheetToPDF()
'Update by Extendoffice 20220803
Dim Wb As Workbook
Dim FileName As String
Dim OutlookApp As Object
Dim OutlookMail As Object
On Error Resume Next
Set Wb = Application.ActiveWorkbook
FileName = Wb.FullName
xIndex = VBA.InStrRev(FileName, ".")
If xIndex > 1 Then FileName = VBA.Left(FileName, xIndex - 1)
FileName = FileName & "_" + ActiveSheet.Name & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FileName
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.Display
.To = "xxx@aaa.com"
.CC = "Email Address"
.BCC = "Email Address"
.Subject = "test"
.HTMLBody = "Email body" & "
" & .HTMLBody
.Attachments.Add FileName
'.Send
End With
Kill FileName
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub4. 按下“F5”运行代码，即可获得一个新邮件窗口，当前工作表作为 PDF 附件插入，同时 Outlook 默认签名会自动添加在邮件正文末尾。
3. 使用 VBA 脚本在满足条件时自动从 Excel发送邮件
在上述示例中，你需要手动运行代码来发送邮件。如果希望在满足特定条件时自动触发代码（如单元格达到某值、单元格值变化、到达指定日期等），则可自动发送邮件。本节列举了 Excel 用户在 Google 上常见的自动发送邮件条件，帮助你实现自动化。
3.1 当单元格达到特定值时自动发送邮件
如下图所示，假设你有一个销售表，D6 单元格为销售总额。你希望当销售总额超过10000 时自动向老板发送邮件（自动创建或发送邮件），否则不执行任何操作。
1. 在包含销售表的工作表中，右键点击工作表标签，选择“查看代码”。
2. 在打开的“Microsoft Visual Basic for Applications”窗口中，将以下 VBA代码粘贴到“工作表（代码）”窗口。
VBA代码：当单元格达到特定值时自动发送邮件
Dim xRg As Range
'Update by Extendoffice 20200803
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("D6"), Target)
If xRg Is Nothing Then Exit Sub
If IsNumeric(Target.Value) And Target.Value > 10000 Then
Call Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hi boss" & vbNewLine & vbNewLine & _
"Total sales of over $10,000 in January: " & Range("D6")
On Error Resume Next
With xOutMail
.To = "xxx@aaa.com"
.CC = "Email address"
.BCC = "Email address"
.Subject = "test"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Private Sub Worksheet_Calculate()
Dim xI As Integer
Dim xRg As Range
Set xRg = Range("D6")
On Error GoTo Err01
xI = Int(xRg.Value)
If xI > 10000 Then
Call Mail_small_Text_Outlook
End If
Err01:
End Sub注意事项：
xMailBody = "Hi boss" & vbNewLine & vbNewLine & _
"Total sales of over $10,000 in January: " & Range("D6")从现在起，当 D6 单元格的值超过10000 时，将自动创建一封邮件，如下图所示。
3.2 当单元格值发生变化时自动发送邮件
如下图所示，假设你收到一个包含不同工作表月度销售数据和总销售额的工作簿。你需要核查总销售额，并在其被修改时，将工作簿发回给发送人并通知其单元格已被更改。
1. 在包含销售表的工作表中，右键点击工作表标签，选择“查看代码”。
2. 在打开的“Microsoft Visual Basic for Applications”窗口中，将以下 VBA代码粘贴到工作表（代码）窗口。
VBA代码：当指定单元格值发生变化时自动发送邮件
Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220803
Dim xRgSel As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String
Dim xBoolean As Boolean
Dim xItsRG As Range
Dim xDDs As Range
Dim xDs As Range
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
xBoolean = False
Set xRg = Range("B14")
Set xItsRG = Intersect(Target, xRg)
Set xDDs = Intersect(Target.DirectDependents, xRg)
Set xDs = Intersect(Target.Dependents, xRg)
If Not (xItsRG Is Nothing) Then
Set xRgSel = xItsRG
xBoolean = True
ElseIf Not (xDDs Is Nothing) Then
Set xRgSel = xDDs
xBoolean = True
ElseIf Not (xDs Is Nothing) Then
Set xRgSel = xDs
xBoolean = True
End If
ActiveWorkbook.Save
If xBoolean Then
Debug.Print xRgSel.Address
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
xMailBody = "The cell " & xRgSel.Address(False, False) & _
" in the worksheet '" & Me.Name & "' were modified on " & _
Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _
" by " & Environ$("username") & "."
With xMailItem
.To = "xxx@aaa.com"
.CC = "Email address"
.BCC = "Email address"
.Subject = "Worksheet modified"
.Body = xMailBody
.Attachments.Add (ThisWorkbook.FullName)
.Display
End With
Set xRgSel = Nothing
Set xOutApp = Nothing
Set xMailItem = Nothing
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub注意：在代码中，
从现在起，当 B14 单元格的值发生变化时，将自动创建一封 Outlook 邮件，如下图所示。
3.3 当保存工作簿时自动发送邮件
如果你有一个需要在修改后与他人共享的工作簿，通常需要先保存工作簿，再打开邮件客户端，创建新邮件并添加附件、填写相关字段后发送。本节将介绍如何在每次保存工作簿时自动创建邮件。请按以下步骤操作。
1. 按下“Alt” + “F11”打开“Microsoft Visual Basic for Applications”窗口。
2. 在该窗口中，双击“项目”窗格中的“ThisWorkbook”，然后将以下 VBA代码粘贴到“ThisWorkbook（代码）”窗口。
VBA代码：当保存工作簿时自动发送邮件
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
'Updated by Extendoffice 20220804
Dim xOutApp As Object
Dim xMailItem As Object
Dim xName As String
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
xName = ActiveWorkbook.FullName
With xMailItem
.To = "xxx@aaa.com"
.CC = "Email address"
.BCC = "Email address"
.Subject = "The workbook has been updated"
.Body = "Hi," & Chr(13) & Chr(13) & "File is now updated."
.Attachments.Add xName
.Display
'.send
End With
Set xMailItem = Nothing
Set xOutApp = Nothing
End Sub注意：在代码中，
从现在起，每当按下“Ctrl”+“S”或点击“保存”按钮保存工作簿时，将自动创建一封 Outlook 邮件。你会看到当前工作簿作为附件插入，相关字段已按指定内容填充。见下图：
提示：如果你经常使用该工作簿，建议将其另存为“Excel 启用宏的工作簿”，以便保存 VBA 脚本供后续使用。操作步骤如下。
3.4 在指定时间自动发送邮件
假设你需要每周五上午9 点自动将任务分配工作簿发送给某人，并希望在 Excel 中自动完成，无需手动操作邮件客户端。本节将介绍实现方法。
1. 按下“Alt” + “F11”打开“Microsoft Visual Basic for Applications”窗口。
2. 在“Microsoft Visual Basic for Applications”窗口中，点击“插入”>“模块”，然后将以下 VBA代码粘贴到模块窗口。
VBA代码1：将当前工作簿作为附件从 Excel发送邮件
Sub Timer()
If Weekday(Date) = vbFriday Then
SendWorkBook
Application.OnTime TimeValue("09:00:00"), "Timer"
Else
Application.OnTime TimeValue("09:00:00"), "Timer"
End If
End Sub
Sub SendWorkBook()
'Update by Extendoffice 20220802
Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
On Error Resume Next
With OutlookMail
.To = "xxx@aaa.com"
.CC = "Email Address"
.BCC = "Email Address"
.Subject = "kte feature"
.Body = "Hello, please check and read this document, thank you."
.Attachments.Add Application.ActiveWorkbook.FullName
.Display
'.Send
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub3. 在该窗口中，双击“项目”窗格中的“ThisWorkbook”，然后将以下 VBA代码粘贴到“ThisWorkbook（代码）”窗口。
VBA代码2：在指定时间自动发送邮件
Private Sub Workbook_Open()
Application.OnTime TimeValue("09:00:00"), "Timer"
End Sub注意事项：
4. 保存代码后，将工作簿另存为 Excel 启用宏的工作簿，操作如下。
5. 打开已保存的启用宏工作簿，到达指定日期和时间时将自动创建或发送邮件。
4.其他相关主题
本节收集了你在从 Excel发送邮件时可能遇到的其他主题。
4.1 使用 VBA 脚本从 Excel发送一段单元格区域邮件
假设在 Excel 工作表中有一份月度销售表，如下图所示，你需要将该表作为邮件正文或附件发送给他人。这里为你提供两种实现方法。
你可以运行以下 VBA代码，将一段单元格区域作为邮件正文内容从 Excel发送。
1. 按下“Alt” + “F11”打开“Microsoft Visual Basic for Applications”窗口。
2. 在“Microsoft Visual Basic for Applications”窗口中，点击“工具”>“引用”，勾选“Microsoft Outlook16.0 Object Library”，在“引用 – VBAProject”对话框中点击“确定”。
3. 点击“插入”>“模块”，将以下 VBA代码粘贴到“模块（代码）”窗口。
VBA代码：将一段单元格区域作为邮件正文内容从 Excel发送
Sub SendARangeofCells()
'Updated by Extendoffice 20220809
Dim xRg As Range
Dim I, J As Long
Dim xAddress As String
Dim xMailOut As Object
Dim xOutApp As Object
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xMailOut = xOutApp.CreateItem(olMailItem)
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Please select range you need to paste into email body", "KuTools For Excel", xAddress, , , , , 8)
If xRg Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xOutApp = CreateObject("Outlook.Application")
Set xMailOut = xOutApp.CreateItem(olMailItem)
With xMailOut
.Subject = "test"
.To = "xxx@aaa.com"
.CC = "Email address"
.BCC = "Email address"
.HTMLBody = RangetoHTML(xRg)
.Display
'.Send
End With
Set xMailOut = Nothing
Set xOutApp = Nothing
Application.ScreenUpdating = True
End Sub
' The following VBA script is cited from this page:
' https://stackoverflow.com/questions/18663127/paste-excel-range-in-outlook
Function RangetoHTML(rng As Range)
' By Ron de Bruin.
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
'Close TempWB
TempWB.Close savechanges:=False
'Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function注意：在代码中，
4. 按下“F5”运行代码，在弹出的“Kutools for Excel”对话框中，选择需要作为邮件正文内容发送的单元格区域，点击“确定”。见下图：
随后会自动创建一封 Outlook 邮件，你会看到所选区域已插入到邮件正文中。见下图：
如需将工作表中的一段单元格区域作为附件从 Excel发送邮件，可尝试以下 VBA代码。
1. 按下“Alt” + “F11”键。
2. 在打开的“Microsoft Visual Basic for Applications”窗口中，点击“插入”>“模块”，将以下 VBA代码粘贴到“模块（代码）”窗口。
VBA代码：将区域作为附件从 Excel发送邮件
Sub SendRange()
'Update 20220809
Dim xFile As String
Dim xFormat As Long
Dim Wb As Workbook
Dim Wb2 As Workbook
Dim Ws As Worksheet
Dim FilePath As String
Dim FileName As String
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim WorkRng As Range
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Wb = Application.ActiveWorkbook
Wb.Worksheets.Add
Set Ws = Application.ActiveSheet
WorkRng.Copy Ws.Cells(1, 1)
Ws.Copy
Set Wb2 = Application.ActiveWorkbook
Select Case Wb.FileFormat
Case xlOpenXMLWorkbook:
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
Case xlOpenXMLWorkbookMacroEnabled:
If Wb2.HasVBProject Then
xFile = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
Else
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
End If
Case Excel8:
xFile = ".xls"
xFormat = Excel8
Case xlExcel12:
xFile = ".xlsb"
xFormat = xlExcel12
End Select
FilePath = Environ$("temp") & "\"
FileName = Wb.Name & Format(Now, "dd-mmm-yy h-mm-ss")
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
With OutlookMail
.To = "xxx@aaa.com"
.CC = "Email address"
.BCC = "Email address"
.Subject = "Monthly sales for 2021"
.Body = "Hello, please check and read this document. "
.Attachments.Add Wb2.FullName
.Display
'.Send
End With
Wb2.Close
Kill FilePath & FileName & xFile
Set OutlookMail = Nothing
Set OutlookApp = Nothing
Ws.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub注意事项：
3. 按下“F5”运行代码，在弹出的“Kutools for Excel”对话框中，选择需要作为附件发送的单元格区域，点击“确定”。见下图：
随后会自动创建一封 Outlook 邮件，所选区域已保存为 Excel 工作簿并作为附件插入邮件窗口。见下图：
4.2 在 Excel 中点击按钮时发送邮件
如需通过点击命令按钮触发宏，从 Excel发送邮件（如将当前工作簿作为附件发送），可按以下步骤操作。
1. 点击“开发工具”>“插入”>“命令按钮（ActiveX 控件）”，在工作表中绘制命令按钮。
提示：如已存在命令按钮，可跳过此步骤。
2. 按下“Alt” + “F11”打开“Microsoft Visual Basic for Applications”窗口，在窗口中点击“插入”>“模块”，将用于将当前工作簿作为附件发送邮件的 VBA代码粘贴到模块（代码）窗口。
注意：此处你在第2 步创建的宏名称为“SendWorkbook”。
3. 按下“Alt” + “Q”关闭“Microsoft Visual Basic for Applications”窗口。
4.现在需要将宏分配给命令按钮。右键点击命令按钮，选择右键菜单中的“查看代码”。
5. 随后会弹出“Microsoft Visual Basic for Applications”窗口，你会看到“工作表（代码）”窗口中列出了以下两行。
Private Sub CommandButton1_Click()
End Sub
6. 在命令按钮的子过程内输入已有宏的名称。
7. 按下“Alt” + “Q”关闭“Visual Basic 编辑器”，点击“开发工具”>“设计模式”关闭设计模式。
现在你可以点击命令按钮，将当前工作簿作为附件发送邮件。
4.3 从指定邮箱账户发送邮件
通常使用 VBA代码从 Excel 启动邮件时，发件人邮箱为 Outlook 的默认账户。若你在 Outlook 配置了多个邮箱账户，并希望用某个特定账户发送邮件而非默认账户，可使用以下 VBA代码实现。
此场景下需用到以下代码。
VBA代码1：
Dim OutlookMail As Outlook.MailItemVBA代码2：
For Each xAccount In OutlookApp.Session.Accounts
If VBA.LCase(xAccount.SmtpAddress) = VBA.LCase("zxm@addin99.com") Then 'Specify your email account here
OutlookMail.SendUsingAccount = xAccount
End If
Next如何使用上述 VBA代码？
本例将指定某个邮箱账户，从 Excel发送当前工作簿作为附件。请按以下步骤操作。
1. 按下“Alt” + “F11”，在“Microsoft Visual Basic for Applications”窗口中，点击“工具”>“引用”，勾选“Microsoft Outlook16.0 Object Library”，在“引用 – VBAProject”对话框中点击“确定”。
2. 点击“插入”>“模块”，将以下 VBA代码粘贴到“模块（代码）”窗口。
VBA代码：通过指定 Outlook账户从 Excel发送当前工作簿作为邮件附件
Sub SendWorkBook()
'Update by Extendoffice 20220809
Dim OutlookApp As Object
Dim OutlookMail As Outlook.MailItem 'important! Here can’t be declared as Object
Dim xAccount As Account
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(olMailItem)
On Error Resume Next
'The following lines helps to specify a certian email account
For Each xAccount In OutlookApp.Session.Accounts
If VBA.LCase(xAccount.SmtpAddress) = VBA.LCase("zxm@addin99.com") Then 'Specify your email account here
OutlookMail.SendUsingAccount = xAccount
End If
Next
'End
With OutlookMail
.To = "xxx@aaa.com"
.CC = "Email Address"
.BCC = "Email Address"
.Subject = "kte feature"
.Body = "Hello, please check and read this document, thank you."
.Attachments.Add Application.ActiveWorkbook.FullName
.Display
'.Send
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub3. 按下“F5”运行代码，随后会弹出 Outlook 邮件窗口，你会看到“发件人”字段已填入你在代码中指定的邮箱账户。
4.4 到达指定日期时发送邮件
如需根据特定到期日发送邮件，例如如下图所示，有一个项目表，“当 E2:E7 区域的到期日距离今天小于等于7 天（假设当前日期为2022/8/4）”时，将自动向对应项目负责人发送邮件并通知项目即将到期。
1. 在包含项目表的工作表中，右键点击工作表标签，选择“查看代码”。
2. 在打开的“Microsoft Visual Basic for Applications”窗口中，将以下 VBA代码粘贴到“工作表（代码）”窗口。
VBA代码：到达到期日时自动发送邮件
Public Sub SendMailDueDate()
'Updated by Extendoffice 20220804
Dim xRgDate As Range
Dim xRgSend As Range
Dim xRgText As Range
Dim xRgDone As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xLastRow As Long
Dim vbCrLf As String
Dim xMailBody As String
Dim xRgDateVal As String
Dim xRgSendVal As String
Dim xMailSubject As String
Dim i As Long
On Error Resume Next
Set xRgDate = Range("E2:E7") 'Please reference the due date column range
If xRgDate Is Nothing Then Exit Sub
Set xRgSend = Range("C2:C7") 'Please reference the email addresses column range
If xRgSend Is Nothing Then Exit Sub
Set xRgText = Range("D2:D7") 'Please reference the remark column range (the remark used to notify project leaders of the expiration of the project)
If xRgText Is Nothing Then Exit Sub
xLastRow = xRgDate.Rows.Count
Set xRgDate = xRgDate(1)
Set xRgSend = xRgSend(1)
Set xRgText = xRgText(1)
Set xOutApp = CreateObject("Outlook.Application")
For i = 1 To xLastRow
xRgDateVal = ""
xRgDateVal = xRgDate.Offset(i - 1).Value
If xRgDateVal <> "" Then
If CDate(xRgDateVal) - Date <= 7 And CDate(xRgDateVal) - Date > 0 Then
xRgSendVal = xRgSend.Offset(i - 1).Value
xMailSubject = xRgText.Offset(i - 1).Value & " on " & xRgDateVal
vbCrLf = "
"
xMailBody = ""
xMailBody = xMailBody & "Dear " & xRgSendVal & vbCrLf
xMailBody = xMailBody & "Remark : " & xRgText.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & ""
Set xMailItem = xOutApp.CreateItem(0)
With xMailItem
.Subject = xMailSubject
.To = xRgSendVal
.CC = "Email address"
.BCC = "Email address"
.HTMLBody = xMailBody
.Display
'.Send
End With
Set xMailItem = Nothing
End If
End If
Next
Set xOutApp = Nothing
End Sub注意：在代码中，
3. 按下“F5”运行代码，若到期日符合条件，将自动创建对应邮件。本例中将创建两封邮件，如下图所示。
5. 实用工具，助你轻松从 Excel发送邮件
如果你是 VBA 新手，上述方法可能不易操作。这里推荐使用 Kutools for Excel 的 Send Emails 功能，通过该功能，你只需几步即可轻松从 Excel发送邮件。请按以下步骤操作。
5.1轻松创建包含所需邮箱字段的邮件列表
在使用 Send Emails 功能前，你需要先创建包含所需邮箱字段的邮件列表。此时可使用 Create Mailing List 功能。
1. 点击“Kutools Plus”>“Create Mailing List”。
2. 在打开的“Create Mailing List”窗口中，按如下方式配置。
随后会生成一个示例邮件列表表格，如下图所示。
3.现在你需要将示例中的原始数据替换为自己的字段数据。
现在你已创建好邮件列表表格。请继续使用 Send Emails 功能，根据你创建的字段从 Excel发送邮件。
Kutools for Excel - 通过超过300个必备工具，让Excel功能大幅提升。永久免费享受AI功能！立即获取
5.2轻松发送包含邮件列表中字段的邮件
创建好包含所需字段的邮件列表后（点击查看操作方法），即可用这些字段从 Excel发送邮件。
1.选中整个邮件列表，点击“Kutools Plus”>“Send Emails”。
2. 在“Send Emails”对话框中，按如下方式配置。
3. 随后会弹出“Kutools for Excel”对话框，告知已发送邮件数量，点击“确定”关闭对话框。
提示：你可在 Outlook 的“已发送邮件”文件夹中查看已发送邮件。
5.3轻松发送带有 HTML 正文（包括超链接、图片等）的邮件
Send Emails 功能支持构建 HTML 格式邮件，可包含超链接、图片、不同字号和颜色等丰富内容。
创建好包含所需邮箱字段的邮件列表后，在配置 Send Emails 对话框时，可通过工具栏上的选项丰富正文内容。
见下图：
5.4发送邮件时轻松插入 Outlook 默认签名
在上述方法中，我们演示了通过 VBA代码发送带有 Outlook 默认签名的邮件。使用 Send Emails 功能时，只需勾选一个选项，即可在从 Excel发送的邮件中自动插入 Outlook 默认签名。
创建好包含所需邮箱字段的邮件列表后，在配置 Send Emails 对话框时，点击“选项”>“使用 Outlook 的签名设置”。
注意：请确保“使用 Outlook 的签名设置”选项前有勾选标记。
收件人收到邮件时，可在邮件正文末尾看到 Outlook 默认签名。
5.5轻松从指定邮箱账户发送邮件
如需用某个特定邮箱账户而非默认账户从 Excel发送邮件，Send Emails 功能同样可轻松实现。
创建好包含所需邮箱字段的邮件列表后，在配置 Send Emails 对话框时，点击“选项”>“发送自”，然后选择你需要发送邮件的邮箱账户。
注意：选择邮箱账户后，其前方会显示勾选标记。
Kutools for Excel - 通过超过300个必备工具，让Excel功能大幅提升。永久免费享受AI功能！立即获取
总之，从 Excel发送邮件在日常工作中非常实用。本文涵盖了从 Excel发送邮件的多种场景，如有其他主题或更简便的解决方案，欢迎留言交流。
最佳Office办公效率工具
| 🤖 | Kutools AI 助手：以智能执行为基础，彻底革新数据分析 |代码生成 |自定义公式创建|数据分析与图表生成 |调用Kutools函数…… |
| 热门功能：查找、选中项的背景色或标记重复项 | 删除空行 | 合并列或单元格且不丢失数据 | 四舍五入…… | |
| 高级LOOKUP：多条件VLookup|多值VLookup|多表查找|模糊查找…… | |
| 高级下拉列表：快速创建下拉列表 |依赖下拉列表 | 多选下拉列表…… | |
| 列管理器： 添加指定数量的列 | 移动列 | 切换隐藏列的可见状态 | 比较区域与列…… | |
| 特色功能：网格聚焦 |设计视图 | 增强编辑栏 | 工作簿及工作表管理器 | 资源库（自动文本） | 日期提取 | 合并数据 | 加密/解密单元格 | 按名单发送电子邮件 | 超级筛选 | 特殊筛选（筛选粗体/倾斜/删除线等）…… | |
| 15大工具集：12项 文本工具（添加文本、删除特定字符等）|50+种 图表 类型（甘特图等）|40+实用 公式（基于生日计算年龄等）|19项 插入工具（插入二维码、从路径插入图片等）|12项 转换工具（小写金额转大写、汇率转换等）|7项 合并与分割工具（高级合并行、分割单元格等）| …… |
通过Kutools for Excel提升您的Excel技能，体验前所未有的高效办公。 Kutools for Excel提供300多项高级功能，助您提升效率并节省时间。 点击此处获取您最需要的功能……
Office Tab为Office带来多标签界面，让您的工作更加轻松
- 支持在Word、Excel、PowerPoint中进行多标签编辑与阅读。
- 在同一个窗口的新标签页中打开和创建多个文档，而不是分多个窗口。
- 可提升50%的工作效率，每天为您减少数百次鼠标点击！
所有Kutools加载项，一键安装
Kutools for Office套件包含Excel、Word、Outlook和PowerPoint的插件，以及Office Tab Pro，非常适合跨Office应用团队使用。
- 全能套装——Excel、Word、Outlook和PowerPoint插件+Office Tab Pro
- 单一安装包、单一授权——数分钟即可完成设置（支持MSI）
- 协同更高效——提升Office应用间的整体工作效率
- 30天全功能试用——无需注册，无需信用卡
- 超高性价比——比单独购买更实惠