假設(shè)你有一個Excel，其中列出了所有收件人的信息鲜棠，如下所示：
如果需要向列表中的每個用戶發(fā)送一封郵件肌厨，最好使用當(dāng)前記錄生成一個附件，并且格式如下：
姓名,
發(fā)送消息
你應(yīng)該怎么辦豁陆？一個一個拷貝發(fā)送柑爸？用python？
答案是盒音，都不用表鳍，Excel自己解決。
通過本文祥诽，你將知道以下問題的答案：
- 什么是VBA
- VBA能夠做什么
- 怎么編輯VBA
- 如何將VBA保存到Excel文件
- 為你的VBA腳本創(chuàng)建一個快捷鍵
- VBA如何創(chuàng)建一個Excel文件
- VBA如何將本Excel中的數(shù)據(jù)讀出并寫到另一個文件
- VBA如何生成并發(fā)送一個郵件譬圣？
- 發(fā)送郵件過程總述
1. 什么是VBA
根據(jù)微軟官網(wǎng)的解釋：
Office Visual Basic for Applications (VBA) 是事件驅(qū)動的編程語言，可以借助它擴展 Office 應(yīng)用程序雄坪。
根據(jù)官網(wǎng)定義厘熟，我們不難理解，VBA是用來擴展Office軟件功能的一門編程語言诸衔。并且VBA不僅僅可以用在Excel盯漂，還能用在Outlook颇玷，Access笨农，Word等Office軟件中。
這就為我們使用VBA讀取Excel內(nèi)容并發(fā)送郵件奠定了基礎(chǔ)帖渠。
2. VBA能夠做什么
作為一門編程語言谒亦，理論上講，VBA可以做到任何編程語言可以做到的事情空郊，比如：
- 根據(jù)Excel中數(shù)據(jù)進行數(shù)據(jù)統(tǒng)計份招，并生成報表
- 訪問網(wǎng)絡(luò)，并進行數(shù)據(jù)采集（網(wǎng)絡(luò)爬蟲）
- 進行數(shù)據(jù)遷移狞甚，過濾...
可以說锁摔，只要有Office軟件存在的地方，VBA都可以有用武之地哼审。
3. 怎么編輯VBA
編輯VBA的時候谐腰，通常使用Visual Basic編輯器進行孕豹。要訪問Visual Basic編輯器，需要到功能區(qū)的"開發(fā)工具"選項卡中查找十气。
在手動啟用"開發(fā)工具"選項卡之前励背，它默認(rèn)是禁用掉的，我們可以通過如下方式啟用"開發(fā)工具"選項卡:
- 在 “文件” 選項卡上砸西，選擇 “選項” 以打開 “選項” 對話框叶眉。
- 選擇該對話框左側(cè)的 “自定義功能區(qū)”。
- 在該對話框左側(cè)的 “從下列位置選擇命令” 下芹枷，選擇 “常用命令”衅疙。
- 在該對話框右側(cè)的 “自定義功能區(qū)” 下，從下拉列表框中選擇 “主選項卡”鸳慈，然后選中 “開發(fā)工具” 復(fù)選框炼蛤。
- 選擇“確定”。
備注：在 Office 2007 中蝶涩，顯示 “開發(fā)工具” 選項卡的方法是選擇 Office 按鈕理朋，選擇 “選項”，然后在 “選項” 對話框的 “常用” 類別中選中 “在功能區(qū)顯示‘開發(fā)工具’選項卡” 復(fù)選框绿聘。
https://docs.microsoft.com/zh-cn/office/vba/library-reference/concepts/getting-started-with-vba-in-office
啟用"開發(fā)工具"選項卡之后嗽上，要編輯VBA就很簡單了，只要切換到"開發(fā)工具"選項卡熄攘，點擊"Visual Basic"按鈕兽愤，就會彈出Visual Basic編輯器了：
-
點擊 "Visual Basic" 按鈕
點擊 "Visual Basic" 按鈕 -
彈出Visual Basic編輯器
彈出Visual Basic編輯器
在彈出的"Visual Basic" 編輯器中，我們可以看到挪圾，左側(cè)顯示了工程框和屬性框浅萧。
在工程框中，列出了當(dāng)前以打開的所有的Excel文件信息哲思，如圖所示洼畅，當(dāng)前，我打開了兩個Excel文件棚赔，分別為 "工作簿2.xlsx" 和 "工作簿4)帝簇。
雙擊左側(cè)"工作簿2.xlsx"節(jié)點下的 "Microsoft Excel 對象" -> Sheet1(Sheet1) ，在右側(cè)就會顯示編輯器的編輯區(qū)：
讓我們寫一行代碼靠益，打個招呼丧肴，復(fù)制如下代碼到編輯區(qū)：
Sub SayHello()
MsgBox "Hello"
End Sub
點擊工具欄的運行圖標(biāo)，如圖所示：
然后程序會彈出一個對話框胧后，讓你選擇一個宏芋浮，來執(zhí)行，如下：
在對話框中壳快，我們看到了我們定義的SayHello纸巷，選中它江醇，點擊右側(cè)的"運行"按鈕。
現(xiàn)在何暇，激動人心的時刻到來了陶夜，程序彈出了一個對話框：
到此為止，我們已經(jīng)讓VBA彈出了一個對話框裆站，接下來保存文件条辟。
之后，我們發(fā)現(xiàn)宏胯，我們寫的代碼在"工作簿2.xlsx"中消失了羽嫡。
接下來，我們聊聊怎么把代碼保存到Excel中肩袍。
4. 如何將VBA保存到Excel文件
在默認(rèn)情況下杭棵，office 文件（.xls,.xlsx,*.doc...)不允許保存宏（VBA代碼），這個時候就需要將我們的文件保存為一種特殊的可以包含宏腳本的文件格式氛赐，對于Excel來說魂爪，執(zhí)行如下過程保存：
1. 點擊 "文件"-->"另存為"
2. 選擇文件格式為"Excel啟用宏的工作簿"
3. 點擊"保存"
點擊保存之后，我們就得到了我們的目標(biāo)文件艰管。
最后滓侍，我們發(fā)現(xiàn)广鳍，我們的文件擴展名變成了"xlsm"规哲，這就是我們要保存的目標(biāo)文件了，我們的腳本就保存在這個文件中抒线。
關(guān)閉當(dāng)前Excel缸浦，然后再打開新文件夕冲，我們發(fā)現(xiàn)，我們的腳本已經(jīng)原樣保存了：
5. 為你的VBA腳本創(chuàng)建一個快捷鍵
如果我們要運行一段代碼裂逐，每次都要打開代碼編輯器歹鱼，然后去點擊啟動按鈕，也太麻煩了絮姆。那么有沒有一種快速運行代碼的方法呢醉冤？答案當(dāng)然是肯定的秩霍，那就是為代碼設(shè)置一個快捷鍵篙悯。
設(shè)置快捷鍵的過程如下：
1. 在Excel中選擇"開發(fā)工具"面板，點擊"宏"按鈕
2. 在彈出的宏對話框中铃绒，選中要執(zhí)行的宏鸽照，這里為"Sheet1.SayHello"，之后點擊右側(cè)的"選項"按鈕
3. 在彈出的"宏選項"對話框中颠悬，在快捷鍵輸入快捷鍵矮燎，這里以 r 為例
點擊"確定"按鈕之后定血，激活當(dāng)前Excel窗體，按下 "Ctrl + r"快捷鍵诞外，我們發(fā)現(xiàn)彈出了我們要的消息框澜沟，如下：
6. VBA如何創(chuàng)建一個Excel文件
經(jīng)歷以上內(nèi)容，我們已經(jīng)可以打開Visual Basic編輯器峡谊，可以寫代碼茫虽，可以將代碼保存到文件，最終既们，我們還為我們的代碼執(zhí)行創(chuàng)建了快捷鍵濒析。
那么接下來，為了給我們的郵件添加一個附件啥纸，我們需要先創(chuàng)建一個新的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:
' 最后蜈块，關(guān)閉新建的 Workbook。
newWorkbook.Close
E:
End Sub
接下來迷扇，我們?yōu)樾陆ǖ?Workbook 新增一個 Worksheet百揭，用于寫入數(shù)據(jù):
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:
' 最后，關(guān)閉新建的 Workbook雏胃。
newWorkbook.Close
E:
End Sub
在這里请毛，我們主要是添加了一個工作表，并將工作包的名字命名為 'attachment'瞭亮，運行以上代碼方仿，我們看到在 D 盤下，生成了一個新文件 xx.xlsx，并且有一個工作表名字為 'attachment':
7. VBA如何將本Excel中的數(shù)據(jù)讀出并寫到另一個文件
至第6節(jié)為止仙蚜，我們已經(jīng)可以使用VBA創(chuàng)建一個Excel文件了此洲，那么接下來，我們聊聊怎么向新增的文件中添加內(nèi)容委粉，將代碼修改為如下：
Sub SayHello()
' 定義一個變量呜师，用于引用新建的 Workbook
Dim newWorkbook As Workbook
' 定義一個變量，用于引用新增的 Worksheet
Dim newWorksheet As Worksheet
' 定義一個工作表引用贾节，用于引用當(dāng)前工作簿的 'datasource' 工作表
Dim srcWorksheet As Worksheet
' 分別定義數(shù)據(jù)源標(biāo)題的 Range 和數(shù)據(jù) Range匣掸，用于獲取數(shù)據(jù)
Dim rgTitleSrc As Range
Dim rgDataSrc As Range
' 分別定義目標(biāo)標(biāo)題的 Range 和數(shù)據(jù) Range，用于寫入數(shù)據(jù)
Dim rgTitleDest As Range
Dim rgDataDest As Range
' 標(biāo)記當(dāng)前選中行
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"
' 獲取到當(dāng)前工作簿的 'datasource' 工作表引用
Set srcWorksheet = ThisWorkbook.Worksheets("datasource")
On Error GoTo Dispose
' 激活數(shù)據(jù)源工作表碰酝，以復(fù)制數(shù)據(jù)
srcWorksheet.Activate
On Error GoTo Dispose
' 設(shè)置當(dāng)前選中行
selectedRow = Selection.Row
On Error GoTo Dispose
' 選中標(biāo)題區(qū)域 title
Set rgTitleSrc = srcWorksheet.Range("A1", "C1")
On Error GoTo Dispose
' 選中數(shù)據(jù)區(qū)域，當(dāng)前選中行
Set rgDataSrc = srcWorksheet.Range("A" & selectedRow, "C" & selectedRow)
On Error GoTo Dispose
With newWorksheet
' 復(fù)制數(shù)據(jù)源標(biāo)題
rgTitleSrc.Copy
' 將復(fù)制內(nèi)容粘貼到 A1
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
Application.CutCopyMode = False
' 復(fù)制數(shù)據(jù)源數(shù)據(jù)
rgDataSrc.Copy
.Cells(2, "A").PasteSpecial Paste:=8
.Cells(2, "A").PasteSpecial xlPasteValues, , False, False
.Cells(2, "A").PasteSpecial xlPasteFormats, , False, False
' 激活并選中目標(biāo)工作表
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:
' 最后暖释，關(guān)閉新建的 Workbook袭厂。
newWorkbook.Close
E:
End Sub
好了，讓我們試試成果球匕，按照如下步驟操作纹磺，看看有沒有生成我們要的文件？
1. 選中我們源文件中要添加到目標(biāo)文件數(shù)據(jù)的那一行的任何一個單元格亮曹，如下：
2. 打開新生成的文件橄杨，可以看到數(shù)據(jù)已經(jīng)寫入了新文件
役耕。
8. VBA如何生成并發(fā)送一個郵件采转？
到目前為止，雖然我們成功的生成了我們的目標(biāo)文件瞬痘，但是還沒有關(guān)系到郵件發(fā)送故慈。
本節(jié)，我們將詳細(xì)討論發(fā)送郵件的過程框全。
首先察绷，讓我們給我們剛開始定義的子程序SayHello改個名，叫做GenerateAttachment竣况，如下：
Sub GenerateAttachment()
' 定義一個變量克婶，用于引用新建的 Workbook
Dim newWorkbook As Workbook
' 定義一個變量筒严，用于引用新增的 Worksheet
Dim newWorksheet As Worksheet
' 定義一個工作表引用丹泉，用于引用當(dāng)前工作簿的 'datasource' 工作表
Dim srcWorksheet As Worksheet
' 分別定義數(shù)據(jù)源標(biāo)題的 Range 和數(shù)據(jù) Range情萤，用于獲取數(shù)據(jù)
Dim rgTitleSrc As Range
Dim rgDataSrc As Range
' 分別定義目標(biāo)標(biāo)題的 Range 和數(shù)據(jù) Range，用于寫入數(shù)據(jù)
Dim rgTitleDest As Range
Dim rgDataDest As Range
' 標(biāo)記當(dāng)前選中行
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"
' 獲取到當(dāng)前工作簿的 'datasource' 工作表引用
Set srcWorksheet = ThisWorkbook.Worksheets("datasource")
On Error GoTo Dispose
' 激活數(shù)據(jù)源工作表筋岛，以復(fù)制數(shù)據(jù)
srcWorksheet.Activate
On Error GoTo Dispose
' 設(shè)置當(dāng)前選中行
selectedRow = Selection.Row
On Error GoTo Dispose
' 選中標(biāo)題區(qū)域 title
Set rgTitleSrc = srcWorksheet.Range("A1", "C1")
On Error GoTo Dispose
' 選中數(shù)據(jù)區(qū)域，當(dāng)前選中行
Set rgDataSrc = srcWorksheet.Range("A" & selectedRow, "C" & selectedRow)
On Error GoTo Dispose
With newWorksheet
' 復(fù)制數(shù)據(jù)源標(biāo)題
rgTitleSrc.Copy
' 將復(fù)制內(nèi)容粘貼到 A1
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
Application.CutCopyMode = False
' 復(fù)制數(shù)據(jù)源數(shù)據(jù)
rgDataSrc.Copy
.Cells(2, "A").PasteSpecial Paste:=8
.Cells(2, "A").PasteSpecial xlPasteValues, , False, False
.Cells(2, "A").PasteSpecial xlPasteFormats, , False, False
' 激活并選中目標(biāo)工作表
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:
' 最后寝凌，關(guān)閉新建的 Workbook柒傻。
newWorkbook.Close
E:
End Sub
那么現(xiàn)在，GenerateAttachment存在的意義较木，就只剩下在"D:\xx.xlsx"生成附件文件了红符。
接下來，讓我們在GenerateAttachment上方添加一個函數(shù)伐债，如下：
Sub SendMail()
GenerateAttachment
End Sub
從代碼我們可以看到预侯，SendMail子程序調(diào)用了GenerateAttachment子程序，經(jīng)過測試峰锁，這樣和只有一個GenerateAttachment子程序產(chǎn)生的結(jié)果是一樣的萎馅。
那么，接下來我們怎么辦呢虹蒋？
我們先創(chuàng)建一個Outlook進程糜芳，然后創(chuàng)建一個郵件消息，然后從我們的Excel中讀取消息魄衅，設(shè)置新建郵件消息的內(nèi)容以及將之前生成的附件添加到郵件中耍目，修改SendMail代碼如下：
Sub SendMail()
' 聲明一個引用，用于引用我們的 OutLook 實例徐绑。
Dim mailApp As Object
' 聲明引用邪驮，用于引用我們的郵件實例。
Dim mail As Object
' 用于訪問源工作表中數(shù)據(jù)
Dim srcWorksheet As Worksheet
' 用于記錄當(dāng)前選中行
Dim selectedRow As Integer
' 生成附件
GenerateAttachment
' 獲取到當(dāng)前工作簿的 'datasource' 工作表引用
Set srcWorksheet = ThisWorkbook.Worksheets("datasource")
On Error GoTo E
' 激活數(shù)據(jù)源工作表傲茄，以復(fù)制數(shù)據(jù)
srcWorksheet.Activate
On Error GoTo E
' 設(shè)置當(dāng)前選中行
selectedRow = Selection.Row
On Error GoTo E
' 生成 Outlook 程序?qū)ο? Set mailApp = CreateObject("Outlook.Application")
On Error GoTo Dispose
' 生成一個郵件信息
Set mail = mailApp.CreateItem(olMailItem)
On Error GoTo Dispose
With mail
' 設(shè)置收件人為源工作表的當(dāng)前選中行的B列單元格的值
.To = srcWorksheet.Cells(selectedRow, "B").Value
' 設(shè)置抄送人
.CC = ""
' 設(shè)置密送人
.BCC = ""
' 設(shè)置郵件標(biāo)題
.Subject = "一封新郵件"
' 設(shè)置附件毅访，附件已經(jīng)由 GenerateAttachment 子程序放在
' D:\xx.xlsx，所以這里我們直接將其添加進來
.Attachments.Add "D:\xx.xlsx"
' 設(shè)置郵件內(nèi)容文本盘榨，其中從A列取用戶名喻粹，C列取消息
' 然后合并，作為郵件體
.Body = srcWorksheet.Cells(selectedRow, "A").Value & "," & vbNewLine & srcWorksheet.Cells(selectedRow, "C").Value
' 最后草巡，顯示郵件信息
.Display
End With
Dispose:
E:
End Sub
試運行守呜，我們發(fā)現(xiàn)，生成了目標(biāo)附件，并且彈出了一個Outlook新建郵件的窗口查乒，如下：
嗯弥喉，看起來不錯，我們得到了郵件玛迄，然后我們再編輯快捷方式由境，將 SendMail的調(diào)用快捷方式改為 "Ctrl+r"，那么每次我們選中一行數(shù)據(jù)蓖议，并且按下快捷鍵的時候虏杰，就會自動生成我們要發(fā)送的文件了。
注意：
- 這里為了演示方便勒虾，我們將生成附件的路徑寫死了纺阔，請根據(jù)你的實際情況修改；
- 在運行宏的時候修然，有可能遇到宏被禁用的情況笛钝，這種情況下，打開Excel(xlsm)文件時低零，在Excel上方會顯示啟用宏的提示婆翔，只要點擊啟用就可以了。
- 在運行我們的程序的時候掏婶，目標(biāo)Excel(xx.xlsx)不能打開啃奴，否則會導(dǎo)致生成附件失敗。
9. 發(fā)送郵件過程總述
好了雄妥，我們總結(jié)一下使用Excel發(fā)送郵件的主流程：
- 使用 Workbooks.Add 方法最蕾，新建一個Excel附件工作簿；
- 使用 newWorkbook.Sheets.Add 方法老厌，新增一個工作表瘟则；
- 使用 newWorksheet.Name，設(shè)置新建工作表的名稱枝秤；
- 使用 newWorksheet.Range 方法醋拧，分別選中要添加到目標(biāo)文件的區(qū)域；
- 使用Range.Copy以及Cells.PasteSpecial.Paste等淀弹，將復(fù)制的區(qū)域復(fù)制到目標(biāo)工作表的指定位置丹壕；
- 使用newWorkbook.SaveAs方法，將工作表保存到我們預(yù)定義的位置薇溃；
- 使用 CreateObject("Outlook.Application") 調(diào)用菌赖，生成一個Outlook進程對象；
- 使用 mailApp.CreateItem(olMailItem)調(diào)用沐序，生成一個郵件對象琉用；
- 分別設(shè)置郵件對象的屬性堕绩；
- 調(diào)用mail.Display顯示郵件或者調(diào)用mail.Send發(fā)送郵件；
到了最后邑时，我們的全部代碼如下：
Sub SendMail()
' 聲明一個引用奴紧，用于引用我們的 OutLook 實例。
Dim mailApp As Object
' 聲明引用刁愿，用于引用我們的郵件實例绰寞。
Dim mail As Object
' 用于訪問源工作表中數(shù)據(jù)
Dim srcWorksheet As Worksheet
' 用于記錄當(dāng)前選中行
Dim selectedRow As Integer
' 生成附件
GenerateAttachment
' 獲取到當(dāng)前工作簿的 'datasource' 工作表引用
Set srcWorksheet = ThisWorkbook.Worksheets("datasource")
On Error GoTo E
' 激活數(shù)據(jù)源工作表到逊，以復(fù)制數(shù)據(jù)
srcWorksheet.Activate
On Error GoTo E
' 設(shè)置當(dāng)前選中行
selectedRow = Selection.Row
On Error GoTo E
' 生成 Outlook 程序?qū)ο? Set mailApp = CreateObject("Outlook.Application")
On Error GoTo Dispose
' 生成一個郵件信息
Set mail = mailApp.CreateItem(olMailItem)
On Error GoTo Dispose
With mail
' 設(shè)置收件人為源工作表的當(dāng)前選中行的B列單元格的值
.To = srcWorksheet.Cells(selectedRow, "B").Value
' 設(shè)置抄送人
.CC = ""
' 設(shè)置密送人
.BCC = ""
' 設(shè)置郵件標(biāo)題
.Subject = "一封新郵件"
' 設(shè)置附件铣口，附件已經(jīng)由 GenerateAttachment 子程序放在
' D:\xx.xlsx，所以這里我們直接將其添加進來
.Attachments.Add "D:\xx.xlsx"
' 設(shè)置郵件內(nèi)容文本觉壶，其中從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
' 定義一個工作表引用争剿，用于引用當(dāng)前工作簿的 'datasource' 工作表
Dim srcWorksheet As Worksheet
' 分別定義數(shù)據(jù)源標(biāo)題的 Range 和數(shù)據(jù) Range已艰，用于獲取數(shù)據(jù)
Dim rgTitleSrc As Range
Dim rgDataSrc As Range
' 分別定義目標(biāo)標(biāo)題的 Range 和數(shù)據(jù) Range，用于寫入數(shù)據(jù)
Dim rgTitleDest As Range
Dim rgDataDest As Range
' 標(biāo)記當(dāng)前選中行
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"
' 獲取到當(dāng)前工作簿的 'datasource' 工作表引用
Set srcWorksheet = ThisWorkbook.Worksheets("datasource")
On Error GoTo Dispose
' 激活數(shù)據(jù)源工作表哩掺，以復(fù)制數(shù)據(jù)
srcWorksheet.Activate
On Error GoTo Dispose
' 設(shè)置當(dāng)前選中行
selectedRow = Selection.Row
On Error GoTo Dispose
' 選中標(biāo)題區(qū)域 title
Set rgTitleSrc = srcWorksheet.Range("A1", "C1")
On Error GoTo Dispose
' 選中數(shù)據(jù)區(qū)域，當(dāng)前選中行
Set rgDataSrc = srcWorksheet.Range("A" & selectedRow, "C" & selectedRow)
On Error GoTo Dispose
With newWorksheet
' 復(fù)制數(shù)據(jù)源標(biāo)題
rgTitleSrc.Copy
' 將復(fù)制內(nèi)容粘貼到 A1
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
Application.CutCopyMode = False
' 復(fù)制數(shù)據(jù)源數(shù)據(jù)
rgDataSrc.Copy
.Cells(2, "A").PasteSpecial Paste:=8
.Cells(2, "A").PasteSpecial xlPasteValues, , False, False
.Cells(2, "A").PasteSpecial xlPasteFormats, , False, False
' 激活并選中目標(biāo)工作表
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:
' 最后蹬碧，關(guān)閉新建的 Workbook舱禽。
newWorkbook.Close
E:
End Sub
最后的最后，不要忘了關(guān)注公眾號[編程之路漫漫]恩沽，碼途求知己誊稚，天涯覓一心。
