嗯，看起来不错，我们得到了邮件，然后我们再编辑快捷方式，将 SendMail的调用快捷方式改为 "Ctrl+r"，那么每次我们选中一行数据，并且按下快捷键的时候，就会自动生成我们要发送的文件了。
注意：
这里为了演示方便，我们将生成附件的路径写死了，请根据你的实际情况修改；
在运行宏的时候，有可能遇到宏被禁用的情况，这种情况下，打开Excel(xlsm)文件时，在Excel上方会显示启用宏的提示，只要点击启用就可以了。
在运行我们的程序的时候，目标Excel(xx.xlsx)不能打开，否则会导致生成附件失败。
9. 发送邮件过程总述好了，我们总结一下使用Excel发送邮件的主流程：
使用 Workbooks.Add 方法，新建一个Excel附件工作簿；
使用 newWorkbook.Sheets.Add 方法，新增一个工作表；
使用 newWorksheet.Name，设置新建工作表的名称；
使用 newWorksheet.Range 方法，分别选中要添加到目标文件的区域；
使用Range.Copy以及Cells.PasteSpecial.Paste等，将复制的区域复制到目标工作表的指定位置；
使用newWorkbook.SaveAs方法，将工作表保存到我们预定义的位置；
使用 CreateObject("Outlook.Application") 调用，生成一个Outlook进程对象；
使用 mailApp.CreateItem(olMailItem)调用，生成一个邮件对象；
分别设置邮件对象的属性；
调用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" 路径。 ' 这里如果文件已存在，会提示是否覆盖. ' 路径要使用 '\' 进行目录隔离，使用'http://www.likecs.com/'会报错 newWorkbook.SaveAs ("D:\xx.xlsx") On Error GoTo Dispose Dispose: ' 最后，关闭新建的 Workbook。 newWorkbook.Close E: End Sub最后的最后，不要忘了关注公众号[编程之路漫漫]，码途求知己，天涯觅一心。