如何使用Excel发送邮件？

假设你有一个Excel，其中列出了所有收件人的信息，如下所示：

如果需要向列表中的每个用户发送一封邮件，最好使用当前记录生成一个附件，并且格式如下：

姓名,
发送消息

你应该怎么办？一个一个拷贝发送？用python？

答案是，都不用，Excel自己解决。

通过本文，你将知道以下问题的答案：

1. 什么是VBA
2. VBA能够做什么
3. 怎么编辑VBA
4. 如何将VBA保存到Excel文件
5. 为你的VBA脚本创建一个快捷键
6. VBA如何创建一个Excel文件
7. VBA如何将本Excel中的数据读出并写到另一个文件
8. VBA如何生成并发送一个邮件？
9. 发送邮件过程总述

1. 什么是VBA

根据微软官网的解释：

Office Visual Basic for Applications (VBA) 是事件驱动的编程语言，可以借助它扩展 Office 应用程序。

https://docs.microsoft.com/zh-cn/office/vba/api/overview/

根据官网定义，我们不难理解，VBA是用来扩展Office软件功能的一门编程语言。并且VBA不仅仅可以用在Excel，还能用在Outlook，Access，Word等Office软件中。

这就为我们使用VBA读取Excel内容并发送邮件奠定了基础。

2. VBA能够做什么

作为一门编程语言，理论上讲，VBA可以做到任何编程语言可以做到的事情，比如：

• 根据Excel中数据进行数据统计，并生成报表
• 访问网络，并进行数据采集（网络爬虫）
• 进行数据迁移，过滤...

可以说，只要有Office软件存在的地方，VBA都可以有用武之地。

3. 怎么编辑VBA

编辑VBA的时候，通常使用Visual Basic编辑器进行。要访问Visual Basic编辑器，需要到功能区的"开发工具"选项卡中查找。

在手动启用"开发工具"选项卡之前，它默认是禁用掉的，我们可以通过如下方式启用"开发工具"选项卡:

1. 在 “文件” 选项卡上，选择 “选项” 以打开 “选项” 对话框。
2. 选择该对话框左侧的 “自定义功能区”。
3. 在该对话框左侧的 “从下列位置选择命令” 下，选择 “常用命令”。
4. 在该对话框右侧的 “自定义功能区” 下，从下拉列表框中选择 “主选项卡”，然后选中 “开发工具” 复选框。
5. 选择“确定”。

备注：在 Office 2007 中，显示 “开发工具” 选项卡的方法是选择 Office 按钮，选择 “选项”，然后在 “选项” 对话框的 “常用” 类别中选中 “在功能区显示‘开发工具’选项卡” 复选框。

https://docs.microsoft.com/zh-cn/office/vba/library-reference/concepts/getting-started-with-vba-in-office

启用"开发工具"选项卡之后，要编辑VBA就很简单了，只要切换到"开发工具"选项卡，点击"Visual Basic"按钮，就会弹出Visual Basic编辑器了：

1. 点击 "Visual Basic" 按钮
   
   

2. 弹出Visual Basic编辑器
   
   
   
   在弹出的"Visual Basic" 编辑器中，我们可以看到，左侧显示了工程框和属性框。
   
   在工程框中，列出了当前以打开的所有的Excel文件信息，如图所示，当前，我打开了两个Excel文件，分别为 "工作簿2.xlsx" 和 "工作簿4)。

双击左侧"工作簿2.xlsx"节点下的 "Microsoft Excel 对象" -> Sheet1(Sheet1) ，在右侧就会显示编辑器的编辑区：

让我们写一行代码，打个招呼，复制如下代码到编辑区：

Sub SayHello()
    MsgBox "Hello"
End Sub

点击工具栏的运行图标，如图所示：

然后程序会弹出一个对话框，让你选择一个宏，来执行，如下：

在对话框中，我们看到了我们定义的SayHello，选中它，点击右侧的"运行"按钮。

现在，激动人心的时刻到来了，程序弹出了一个对话框：

到此为止，我们已经让VBA弹出了一个对话框，接下来保存文件。

之后，我们发现，我们写的代码在"工作簿2.xlsx"中消失了。

接下来，我们聊聊怎么把代码保存到Excel中。

4. 如何将VBA保存到Excel文件

在默认情况下，office 文件（.xls,.xlsx,*.doc...)不允许保存宏（VBA代码），这个时候就需要将我们的文件保存为一种特殊的可以包含宏脚本的文件格式，对于Excel来说，执行如下过程保存：

1. 点击 "文件"-->"另存为"

2. 选择文件格式为"Excel启用宏的工作簿"

3. 点击"保存"

点击保存之后，我们就得到了我们的目标文件。

最后，我们发现，我们的文件扩展名变成了"xlsm"，这就是我们要保存的目标文件了，我们的脚本就保存在这个文件中。

关闭当前Excel，然后再打开新文件，我们发现，我们的脚本已经原样保存了：

5. 为你的VBA脚本创建一个快捷键

如果我们要运行一段代码，每次都要打开代码编辑器，然后去点击启动按钮，也太麻烦了。那么有没有一种快速运行代码的方法呢？答案当然是肯定的，那就是为代码设置一个快捷键。

设置快捷键的过程如下：

1. 在Excel中选择"开发工具"面板，点击"宏"按钮

2. 在弹出的宏对话框中，选中要执行的宏，这里为"Sheet1.SayHello"，之后点击右侧的"选项"按钮

3. 在弹出的"宏选项"对话框中，在快捷键输入快捷键，这里以 r 为例

点击"确定"按钮之后，激活当前Excel窗体，按下 "Ctrl + r"快捷键，我们发现弹出了我们要的消息框，如下：

6. VBA如何创建一个Excel文件

经历以上内容，我们已经可以打开Visual Basic编辑器，可以写代码，可以将代码保存到文件，最终，我们还为我们的代码执行创建了快捷键。

那么接下来，为了给我们的邮件添加一个附件，我们需要先创建一个新的Excel工作簿文档，怎么做呢？

在我们写代码之前，请先参考如下资料：

了解 Visual Basic 语法

https://docs.microsoft.com/zh-cn/office/vba/language/concepts/getting-started/understanding-visual-basic-syntax

Office VBA入门

https://docs.microsoft.com/zh-cn/office/vba/library-reference/concepts/getting-started-with-vba-in-office

Application 对象 (Excel Graph)

https://docs.microsoft.com/zh-cn/office/vba/api/excel.application-graph-object

在了解以上信息之后，我们不难理解如下代码：

Sub SayHello()
    ' 定义一个变量，用于引用新建的 Workbook
    Dim newWorkbook  As Workbook
    ' 新增一个 Workbook，并引用
    Set newWorkbook = Workbooks.Add
        On Error GoTo E
    ' 将新建的 Workbook 保存到 "D:\xx.xlsx" 路径。
    ' 这里如果文件已存在，会提示是否覆盖.
    ' 路径要使用 '\' 进行目录隔离，使用'/'会报错
    newWorkbook.SaveAs ("D:\xx.xlsx")
        On Error GoTo Dispose
Dispose:
    ' 最后，关闭新建的 Workbook。
    newWorkbook.Close
E:
End Sub

接下来，我们为新建的 Workbook 新增一个 Worksheet，用于写入数据:

Sub SayHello()
    ' 定义一个变量，用于引用新建的 Workbook
    Dim newWorkbook  As Workbook
    ' 定义一个变量，用于引用新增的 Worksheet
    Dim newWorksheet As Worksheet
    ' 新增一个 Workbook，并引用
    Set newWorkbook = Workbooks.Add
        On Error GoTo E

    ' 添加一个 Worksheet
    Set newWorksheet = newWorkbook.Sheets.Add
        On Error GoTo E
    ' 将新建的 Worksheet 命名为 'attachment'
    newWorksheet.Name = "attachment"

    ' 将新建的 Workbook 保存到 "D:\xx.xlsx" 路径。
    ' 这里如果文件已存在，会提示是否覆盖.
    ' 路径要使用 '\' 进行目录隔离，使用'/'会报错
    newWorkbook.SaveAs ("D:\xx.xlsx")
        On Error GoTo Dispose
Dispose:
    ' 最后，关闭新建的 Workbook。
    newWorkbook.Close
E:
End Sub

在这里，我们主要是添加了一个工作表，并将工作包的名字命名为 'attachment'，运行以上代码，我们看到在 D 盘下，生成了一个新文件 xx.xlsx，并且有一个工作表名字为 'attachment':

7. VBA如何将本Excel中的数据读出并写到另一个文件

至第6节为止，我们已经可以使用VBA创建一个Excel文件了，那么接下来，我们聊聊怎么向新增的文件中添加内容，将代码修改为如下：

Sub SayHello()
    ' 定义一个变量，用于引用新建的 Workbook
    Dim newWorkbook  As Workbook
    ' 定义一个变量，用于引用新增的 Worksheet
    Dim newWorksheet As Worksheet
    ' 定义一个工作表引用，用于引用当前工作簿的 'datasource' 工作表
    Dim srcWorksheet As Worksheet

    ' 分别定义数据源标题的 Range 和数据 Range，用于获取数据
    Dim rgTitleSrc   As Range
    Dim rgDataSrc    As Range

    ' 分别定义目标标题的 Range 和数据 Range，用于写入数据
    Dim rgTitleDest  As Range
    Dim rgDataDest   As Range

    ' 标记当前选中行
    Dim selectedRow  As Integer

    ' 新增一个 Workbook，并引用
    Set newWorkbook = Workbooks.Add
        On Error GoTo E

    ' 添加一个 Worksheet
    Set newWorksheet = newWorkbook.Sheets.Add
        On Error GoTo Dispose

    ' 将新建的 Worksheet 命名为 'attachment'
    newWorksheet.Name = "attachment"

    ' 获取到当前工作簿的 'datasource' 工作表引用
    Set srcWorksheet = ThisWorkbook.Worksheets("datasource")
        On Error GoTo Dispose

    ' 激活数据源工作表，以复制数据
    srcWorksheet.Activate
        On Error GoTo Dispose
    ' 设置当前选中行
    selectedRow = Selection.Row
        On Error GoTo Dispose

    ' 选中标题区域 title
    Set rgTitleSrc = srcWorksheet.Range("A1", "C1")
        On Error GoTo Dispose
    ' 选中数据区域，当前选中行
    Set rgDataSrc = srcWorksheet.Range("A" & selectedRow, "C" & selectedRow)
        On Error GoTo Dispose

    With newWorksheet
        ' 复制数据源标题
        rgTitleSrc.Copy
        ' 将复制内容粘贴到 A1
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False

        Application.CutCopyMode = False
        ' 复制数据源数据
        rgDataSrc.Copy
        .Cells(2, "A").PasteSpecial Paste:=8
        .Cells(2, "A").PasteSpecial xlPasteValues, , False, False
        .Cells(2, "A").PasteSpecial xlPasteFormats, , False, False
        ' 激活并选中目标工作表
        newWorkbook.Activate
        newWorkbook.Sheets(newWorksheet.Index).Select
        '最终选中 A1 单元格
        .Cells(1).Select
            On Error Resume Next

        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
            On Error GoTo Dispose

    End With

    ' 将新建的 Workbook 保存到 "D:\xx.xlsx" 路径。
    ' 这里如果文件已存在，会提示是否覆盖.
    ' 路径要使用 '\' 进行目录隔离，使用'/'会报错
    newWorkbook.SaveAs ("D:\xx.xlsx")
        On Error GoTo Dispose
Dispose:
    ' 最后，关闭新建的 Workbook。
    newWorkbook.Close
E:
End Sub

好了，让我们试试成果，按照如下步骤操作，看看有没有生成我们要的文件？

1. 选中我们源文件中要添加到目标文件数据的那一行的任何一个单元格，如下：

2.

可以看到，我们需要的数据已经放到目标文件中去了。怎么做到的呢？看看代码中以单引号开始的行吧，有说明

。

8. VBA如何生成并发送一个邮件？

到目前为止，虽然我们成功的生成了我们的目标文件，但是还没有关系到邮件发送。

本节，我们将详细讨论发送邮件的过程。

首先，让我们给我们刚开始定义的子程序SayHello改个名，叫做GenerateAttachment，如下：

Sub GenerateAttachment()
    ' 定义一个变量，用于引用新建的 Workbook
    Dim newWorkbook  As Workbook
    ' 定义一个变量，用于引用新增的 Worksheet
    Dim newWorksheet As Worksheet
    ' 定义一个工作表引用，用于引用当前工作簿的 'datasource' 工作表
    Dim srcWorksheet As Worksheet

    ' 分别定义数据源标题的 Range 和数据 Range，用于获取数据
    Dim rgTitleSrc   As Range
    Dim rgDataSrc    As Range

    ' 分别定义目标标题的 Range 和数据 Range，用于写入数据
    Dim rgTitleDest  As Range
    Dim rgDataDest   As Range

    ' 标记当前选中行
    Dim selectedRow  As Integer

    ' 新增一个 Workbook，并引用
    Set newWorkbook = Workbooks.Add
        On Error GoTo E

    ' 添加一个 Worksheet
    Set newWorksheet = newWorkbook.Sheets.Add
        On Error GoTo Dispose

    ' 将新建的 Worksheet 命名为 'attachment'
    newWorksheet.Name = "attachment"

    ' 获取到当前工作簿的 'datasource' 工作表引用
    Set srcWorksheet = ThisWorkbook.Worksheets("datasource")
        On Error GoTo Dispose

    ' 激活数据源工作表，以复制数据
    srcWorksheet.Activate
        On Error GoTo Dispose
    ' 设置当前选中行
    selectedRow = Selection.Row
        On Error GoTo Dispose

    ' 选中标题区域 title
    Set rgTitleSrc = srcWorksheet.Range("A1", "C1")
        On Error GoTo Dispose
    ' 选中数据区域，当前选中行
    Set rgDataSrc = srcWorksheet.Range("A" & selectedRow, "C" & selectedRow)
        On Error GoTo Dispose

    With newWorksheet
        ' 复制数据源标题
        rgTitleSrc.Copy
        ' 将复制内容粘贴到 A1
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False

        Application.CutCopyMode = False
        ' 复制数据源数据
        rgDataSrc.Copy
        .Cells(2, "A").PasteSpecial Paste:=8
        .Cells(2, "A").PasteSpecial xlPasteValues, , False, False
        .Cells(2, "A").PasteSpecial xlPasteFormats, , False, False
        ' 激活并选中目标工作表
        newWorkbook.Activate
        newWorkbook.Sheets(newWorksheet.Index).Select
        '最终选中 A1 单元格
        .Cells(1).Select
            On Error Resume Next

        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
            On Error GoTo Dispose

    End With

    ' 将新建的 Workbook 保存到 "D:\xx.xlsx" 路径。
    ' 这里如果文件已存在，会提示是否覆盖.
    ' 路径要使用 '\' 进行目录隔离，使用'/'会报错
    newWorkbook.SaveAs ("D:\xx.xlsx")
        On Error GoTo Dispose
Dispose:
    ' 最后，关闭新建的 Workbook。
    newWorkbook.Close
E:
End Sub

那么现在，GenerateAttachment存在的意义，就只剩下在"D:\xx.xlsx"生成附件文件了。

接下来，让我们在GenerateAttachment上方添加一个函数，如下：

Sub SendMail()
    GenerateAttachment
End Sub

从代码我们可以看到，SendMail子程序调用了GenerateAttachment子程序，经过测试，这样和只有一个GenerateAttachment子程序产生的结果是一样的。

那么，接下来我们怎么办呢？

我们先创建一个Outlook进程，然后创建一个邮件消息，然后从我们的Excel中读取消息，设置新建邮件消息的内容以及将之前生成的附件添加到邮件中，修改SendMail代码如下：

Sub SendMail()

    ' 声明一个引用，用于引用我们的 OutLook 实例。
    Dim mailApp      As Object
    ' 声明引用，用于引用我们的邮件实例。
    Dim mail         As Object

    ' 用于访问源工作表中数据
    Dim srcWorksheet As Worksheet
    ' 用于记录当前选中行
    Dim selectedRow  As Integer

    ' 生成附件
    GenerateAttachment

    ' 获取到当前工作簿的 'datasource' 工作表引用
    Set srcWorksheet = ThisWorkbook.Worksheets("datasource")
        On Error GoTo E

    ' 激活数据源工作表，以复制数据
    srcWorksheet.Activate
        On Error GoTo E
    ' 设置当前选中行
    selectedRow = Selection.Row
        On Error GoTo E

    ' 生成 Outlook 程序对象
    Set mailApp = CreateObject("Outlook.Application")
        On Error GoTo Dispose
    ' 生成一个邮件信息
    Set mail = mailApp.CreateItem(olMailItem)
        On Error GoTo Dispose

    With mail
        ' 设置收件人为源工作表的当前选中行的B列单元格的值
        .To = srcWorksheet.Cells(selectedRow, "B").Value
        ' 设置抄送人
        .CC = ""
        ' 设置密送人
        .BCC = ""
        ' 设置邮件标题
        .Subject = "一封新邮件"
        ' 设置附件，附件已经由 GenerateAttachment 子程序放在
        ' D:\xx.xlsx，所以这里我们直接将其添加进来
        .Attachments.Add "D:\xx.xlsx"
        ' 设置邮件内容文本，其中从A列取用户名，C列取消息
        ' 然后合并，作为邮件体
        .Body = srcWorksheet.Cells(selectedRow, "A").Value & "," & vbNewLine & srcWorksheet.Cells(selectedRow, "C").Value
        ' 最后，显示邮件信息
        .Display
    End With

Dispose:
E:

End Sub

试运行，我们发现，生成了目标附件，并且弹出了一个Outlook新建邮件的窗口，如下：

嗯，看起来不错，我们得到了邮件，然后我们再编辑快捷方式，将 SendMail的调用快捷方式改为 "Ctrl+r"，那么每次我们选中一行数据，并且按下快捷键的时候，就会自动生成我们要发送的文件了。

注意：

1. 这里为了演示方便，我们将生成附件的路径写死了，请根据你的实际情况修改；
2. 在运行宏的时候，有可能遇到宏被禁用的情况，这种情况下，打开Excel(xlsm)文件时，在Excel上方会显示启用宏的提示，只要点击启用就可以了。
3. 在运行我们的程序的时候，目标Excel(xx.xlsx)不能打开，否则会导致生成附件失败。

9. 发送邮件过程总述

好了，我们总结一下使用Excel发送邮件的主流程：

1. 使用 Workbooks.Add 方法，新建一个Excel附件工作簿；
2. 使用 newWorkbook.Sheets.Add 方法，新增一个工作表；
3. 使用 newWorksheet.Name，设置新建工作表的名称；
4. 使用 newWorksheet.Range 方法，分别选中要添加到目标文件的区域；
5. 使用Range.Copy以及Cells.PasteSpecial.Paste等，将复制的区域复制到目标工作表的指定位置；
6. 使用newWorkbook.SaveAs方法，将工作表保存到我们预定义的位置；
7. 使用 CreateObject("Outlook.Application") 调用，生成一个Outlook进程对象；
8. 使用 mailApp.CreateItem(olMailItem)调用，生成一个邮件对象；
9. 分别设置邮件对象的属性；
10. 调用mail.Display显示邮件或者调用mail.Send发送邮件；

到了最后，我们的全部代码如下：

Sub SendMail()

    ' 声明一个引用，用于引用我们的 OutLook 实例。
    Dim mailApp      As Object
    ' 声明引用，用于引用我们的邮件实例。
    Dim mail         As Object

    ' 用于访问源工作表中数据
    Dim srcWorksheet As Worksheet
    ' 用于记录当前选中行
    Dim selectedRow  As Integer

    ' 生成附件
    GenerateAttachment

    ' 获取到当前工作簿的 'datasource' 工作表引用
    Set srcWorksheet = ThisWorkbook.Worksheets("datasource")
        On Error GoTo E

    ' 激活数据源工作表，以复制数据
    srcWorksheet.Activate
        On Error GoTo E
    ' 设置当前选中行
    selectedRow = Selection.Row
        On Error GoTo E

    ' 生成 Outlook 程序对象
    Set mailApp = CreateObject("Outlook.Application")
        On Error GoTo Dispose
    ' 生成一个邮件信息
    Set mail = mailApp.CreateItem(olMailItem)
        On Error GoTo Dispose

    With mail
        ' 设置收件人为源工作表的当前选中行的B列单元格的值
        .To = srcWorksheet.Cells(selectedRow, "B").Value
        ' 设置抄送人
        .CC = ""
        ' 设置密送人
        .BCC = ""
        ' 设置邮件标题
        .Subject = "一封新邮件"
        ' 设置附件，附件已经由 GenerateAttachment 子程序放在
        ' D:\xx.xlsx，所以这里我们直接将其添加进来
        .Attachments.Add "D:\xx.xlsx"
        ' 设置邮件内容文本，其中从A列取用户名，C列取消息
        ' 然后合并，作为邮件体
        .Body = srcWorksheet.Cells(selectedRow, "A").Value & "," & vbNewLine & srcWorksheet.Cells(selectedRow, "C").Value
        ' 最后，显示邮件信息
        .Display
    End With

Dispose:
E:

End Sub

Sub GenerateAttachment()
    ' 定义一个变量，用于引用新建的 Workbook
    Dim newWorkbook  As Workbook
    ' 定义一个变量，用于引用新增的 Worksheet
    Dim newWorksheet As Worksheet
    ' 定义一个工作表引用，用于引用当前工作簿的 'datasource' 工作表
    Dim srcWorksheet As Worksheet

    ' 分别定义数据源标题的 Range 和数据 Range，用于获取数据
    Dim rgTitleSrc   As Range
    Dim rgDataSrc    As Range

    ' 分别定义目标标题的 Range 和数据 Range，用于写入数据
    Dim rgTitleDest  As Range
    Dim rgDataDest   As Range

    ' 标记当前选中行
    Dim selectedRow  As Integer

    ' 新增一个 Workbook，并引用
    Set newWorkbook = Workbooks.Add
        On Error GoTo E

    ' 添加一个 Worksheet
    Set newWorksheet = newWorkbook.Sheets.Add
        On Error GoTo Dispose

    ' 将新建的 Worksheet 命名为 'attachment'
    newWorksheet.Name = "attachment"

    ' 获取到当前工作簿的 'datasource' 工作表引用
    Set srcWorksheet = ThisWorkbook.Worksheets("datasource")
        On Error GoTo Dispose

    ' 激活数据源工作表，以复制数据
    srcWorksheet.Activate
        On Error GoTo Dispose
    ' 设置当前选中行
    selectedRow = Selection.Row
        On Error GoTo Dispose

    ' 选中标题区域 title
    Set rgTitleSrc = srcWorksheet.Range("A1", "C1")
        On Error GoTo Dispose
    ' 选中数据区域，当前选中行
    Set rgDataSrc = srcWorksheet.Range("A" & selectedRow, "C" & selectedRow)
        On Error GoTo Dispose

    With newWorksheet
        ' 复制数据源标题
        rgTitleSrc.Copy
        ' 将复制内容粘贴到 A1
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False

        Application.CutCopyMode = False
        ' 复制数据源数据
        rgDataSrc.Copy
        .Cells(2, "A").PasteSpecial Paste:=8
        .Cells(2, "A").PasteSpecial xlPasteValues, , False, False
        .Cells(2, "A").PasteSpecial xlPasteFormats, , False, False
        ' 激活并选中目标工作表
        newWorkbook.Activate
        newWorkbook.Sheets(newWorksheet.Index).Select
        '最终选中 A1 单元格
        .Cells(1).Select
            On Error Resume Next

        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
            On Error GoTo Dispose

    End With

    ' 将新建的 Workbook 保存到 "D:\xx.xlsx" 路径。
    ' 这里如果文件已存在，会提示是否覆盖.
    ' 路径要使用 '\' 进行目录隔离，使用'/'会报错
    newWorkbook.SaveAs ("D:\xx.xlsx")
        On Error GoTo Dispose
Dispose:
    ' 最后，关闭新建的 Workbook。
    newWorkbook.Close
E:
End Sub

最后的最后，不要忘了关注公众号[编程之路漫漫]，码途求知己，天涯觅一心。