假設(shè)你有一個(gè)Excel,其中列出了所有收件人的信息,如下所示:

如果需要向列表中的每個(gè)用戶發(fā)送一封郵件,最好使用當(dāng)前記錄生成一個(gè)附件,并且格式如下:
姓名,
發(fā)送消息
你應(yīng)該怎么辦?一個(gè)一個(gè)拷貝發(fā)送?用python?
答案是,都不用,Excel自己解決。
通過本文,你將知道以下問題的答案:
- 什么是VBA
- VBA能夠做什么
- 怎么編輯VBA
- 如何將VBA保存到Excel文件
- 為你的VBA腳本創(chuàng)建一個(gè)快捷鍵
- VBA如何創(chuàng)建一個(gè)Excel文件
- VBA如何將本Excel中的數(shù)據(jù)讀出并寫到另一個(gè)文件
- VBA如何生成并發(fā)送一個(gè)郵件?
- 發(fā)送郵件過程總述
1. 什么是VBA
根據(jù)微軟官網(wǎng)的解釋:
Office Visual Basic for Applications (VBA) 是事件驅(qū)動(dòng)的編程語言,可以借助它擴(kuò)展 Office 應(yīng)用程序。
根據(jù)官網(wǎng)定義,我們不難理解,VBA是用來擴(kuò)展Office軟件功能的一門編程語言。并且VBA不僅僅可以用在Excel,還能用在Outlook,Access,Word等Office軟件中。
這就為我們使用VBA讀取Excel內(nèi)容并發(fā)送郵件奠定了基礎(chǔ)。
2. VBA能夠做什么
作為一門編程語言,理論上講,VBA可以做到任何編程語言可以做到的事情,比如:
- 根據(jù)Excel中數(shù)據(jù)進(jìn)行數(shù)據(jù)統(tǒng)計(jì),并生成報(bào)表
- 訪問網(wǎng)絡(luò),并進(jìn)行數(shù)據(jù)采集(網(wǎng)絡(luò)爬蟲)
- 進(jìn)行數(shù)據(jù)遷移,過濾...
可以說,只要有Office軟件存在的地方,VBA都可以有用武之地。
3. 怎么編輯VBA
編輯VBA的時(shí)候,通常使用Visual Basic編輯器進(jìn)行。要訪問Visual Basic編輯器,需要到功能區(qū)的"開發(fā)工具"選項(xiàng)卡中查找。
在手動(dòng)啟用"開發(fā)工具"選項(xiàng)卡之前,它默認(rèn)是禁用掉的,我們可以通過如下方式啟用"開發(fā)工具"選項(xiàng)卡:
- 在 “文件” 選項(xiàng)卡上,選擇 “選項(xiàng)” 以打開 “選項(xiàng)” 對(duì)話框。
- 選擇該對(duì)話框左側(cè)的 “自定義功能區(qū)”。
- 在該對(duì)話框左側(cè)的 “從下列位置選擇命令” 下,選擇 “常用命令”。
- 在該對(duì)話框右側(cè)的 “自定義功能區(qū)” 下,從下拉列表框中選擇 “主選項(xiàng)卡”,然后選中 “開發(fā)工具” 復(fù)選框。
- 選擇“確定”。
備注:在 Office 2007 中,顯示 “開發(fā)工具” 選項(xiàng)卡的方法是選擇 Office 按鈕,選擇 “選項(xiàng)”,然后在 “選項(xiàng)” 對(duì)話框的 “常用” 類別中選中 “在功能區(qū)顯示‘開發(fā)工具’選項(xiàng)卡” 復(fù)選框。
https://docs.microsoft.com/zh-cn/office/vba/library-reference/concepts/getting-started-with-vba-in-office
啟用"開發(fā)工具"選項(xiàng)卡之后,要編輯VBA就很簡(jiǎn)單了,只要切換到"開發(fā)工具"選項(xiàng)卡,點(diǎn)擊"Visual Basic"按鈕,就會(huì)彈出Visual Basic編輯器了:
-
點(diǎn)擊 "Visual Basic" 按鈕
點(diǎn)擊 "Visual Basic" 按鈕 -
彈出Visual Basic編輯器
彈出Visual Basic編輯器
在彈出的"Visual Basic" 編輯器中,我們可以看到,左側(cè)顯示了工程框和屬性框。
在工程框中,列出了當(dāng)前以打開的所有的Excel文件信息,如圖所示,當(dāng)前,我打開了兩個(gè)Excel文件,分別為 "工作簿2.xlsx" 和 "工作簿4)。
雙擊左側(cè)"工作簿2.xlsx"節(jié)點(diǎn)下的 "Microsoft Excel 對(duì)象" -> Sheet1(Sheet1) ,在右側(cè)就會(huì)顯示編輯器的編輯區(qū):

讓我們寫一行代碼,打個(gè)招呼,復(fù)制如下代碼到編輯區(qū):
Sub SayHello()
MsgBox "Hello"
End Sub
點(diǎn)擊工具欄的運(yùn)行圖標(biāo),如圖所示:

然后程序會(huì)彈出一個(gè)對(duì)話框,讓你選擇一個(gè)宏,來執(zhí)行,如下:

在對(duì)話框中,我們看到了我們定義的SayHello,選中它,點(diǎn)擊右側(cè)的"運(yùn)行"按鈕。
現(xiàn)在,激動(dòng)人心的時(shí)刻到來了,程序彈出了一個(gè)對(duì)話框:

到此為止,我們已經(jīng)讓VBA彈出了一個(gè)對(duì)話框,接下來保存文件。
之后,我們發(fā)現(xiàn),我們寫的代碼在"工作簿2.xlsx"中消失了。
接下來,我們聊聊怎么把代碼保存到Excel中。
4. 如何將VBA保存到Excel文件
在默認(rèn)情況下,office 文件(.xls,.xlsx,*.doc...)不允許保存宏(VBA代碼),這個(gè)時(shí)候就需要將我們的文件保存為一種特殊的可以包含宏腳本的文件格式,對(duì)于Excel來說,執(zhí)行如下過程保存:
1. 點(diǎn)擊 "文件"-->"另存為"

2. 選擇文件格式為"Excel啟用宏的工作簿"

3. 點(diǎn)擊"保存"
點(diǎn)擊保存之后,我們就得到了我們的目標(biāo)文件。

最后,我們發(fā)現(xiàn),我們的文件擴(kuò)展名變成了"xlsm",這就是我們要保存的目標(biāo)文件了,我們的腳本就保存在這個(gè)文件中。
關(guān)閉當(dāng)前Excel,然后再打開新文件,我們發(fā)現(xiàn),我們的腳本已經(jīng)原樣保存了:

5. 為你的VBA腳本創(chuàng)建一個(gè)快捷鍵
如果我們要運(yùn)行一段代碼,每次都要打開代碼編輯器,然后去點(diǎn)擊啟動(dòng)按鈕,也太麻煩了。那么有沒有一種快速運(yùn)行代碼的方法呢?答案當(dāng)然是肯定的,那就是為代碼設(shè)置一個(gè)快捷鍵。
設(shè)置快捷鍵的過程如下:
1. 在Excel中選擇"開發(fā)工具"面板,點(diǎn)擊"宏"按鈕

2. 在彈出的宏對(duì)話框中,選中要執(zhí)行的宏,這里為"Sheet1.SayHello",之后點(diǎn)擊右側(cè)的"選項(xiàng)"按鈕

3. 在彈出的"宏選項(xiàng)"對(duì)話框中,在快捷鍵輸入快捷鍵,這里以 r 為例

點(diǎn)擊"確定"按鈕之后,激活當(dāng)前Excel窗體,按下 "Ctrl + r"快捷鍵,我們發(fā)現(xiàn)彈出了我們要的消息框,如下:

6. VBA如何創(chuàng)建一個(gè)Excel文件
經(jīng)歷以上內(nèi)容,我們已經(jīng)可以打開Visual Basic編輯器,可以寫代碼,可以將代碼保存到文件,最終,我們還為我們的代碼執(zhí)行創(chuàng)建了快捷鍵。
那么接下來,為了給我們的郵件添加一個(gè)附件,我們需要先創(chuàng)建一個(gè)新的Excel工作簿文檔,怎么做呢?
在我們寫代碼之前,請(qǐng)先參考如下資料:
了解 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 對(duì)象 (Excel Graph)
https://docs.microsoft.com/zh-cn/office/vba/api/excel.application-graph-object
在了解以上信息之后,我們不難理解如下代碼:
Sub SayHello()
' 定義一個(gè)變量,用于引用新建的 Workbook
Dim newWorkbook As Workbook
' 新增一個(gè) Workbook,并引用
Set newWorkbook = Workbooks.Add
On Error GoTo E
' 將新建的 Workbook 保存到 "D:\xx.xlsx" 路徑。
' 這里如果文件已存在,會(huì)提示是否覆蓋.
' 路徑要使用 '\' 進(jìn)行目錄隔離,使用'/'會(huì)報(bào)錯(cuò)
newWorkbook.SaveAs ("D:\xx.xlsx")
On Error GoTo Dispose
Dispose:
' 最后,關(guān)閉新建的 Workbook。
newWorkbook.Close
E:
End Sub
接下來,我們?yōu)樾陆ǖ?Workbook 新增一個(gè) Worksheet,用于寫入數(shù)據(jù):
Sub SayHello()
' 定義一個(gè)變量,用于引用新建的 Workbook
Dim newWorkbook As Workbook
' 定義一個(gè)變量,用于引用新增的 Worksheet
Dim newWorksheet As Worksheet
' 新增一個(gè) Workbook,并引用
Set newWorkbook = Workbooks.Add
On Error GoTo E
' 添加一個(gè) Worksheet
Set newWorksheet = newWorkbook.Sheets.Add
On Error GoTo E
' 將新建的 Worksheet 命名為 'attachment'
newWorksheet.Name = "attachment"
' 將新建的 Workbook 保存到 "D:\xx.xlsx" 路徑。
' 這里如果文件已存在,會(huì)提示是否覆蓋.
' 路徑要使用 '\' 進(jìn)行目錄隔離,使用'/'會(huì)報(bào)錯(cuò)
newWorkbook.SaveAs ("D:\xx.xlsx")
On Error GoTo Dispose
Dispose:
' 最后,關(guān)閉新建的 Workbook。
newWorkbook.Close
E:
End Sub
在這里,我們主要是添加了一個(gè)工作表,并將工作包的名字命名為 'attachment',運(yùn)行以上代碼,我們看到在 D 盤下,生成了一個(gè)新文件 xx.xlsx,并且有一個(gè)工作表名字為 'attachment':

7. VBA如何將本Excel中的數(shù)據(jù)讀出并寫到另一個(gè)文件
至第6節(jié)為止,我們已經(jīng)可以使用VBA創(chuàng)建一個(gè)Excel文件了,那么接下來,我們聊聊怎么向新增的文件中添加內(nèi)容,將代碼修改為如下:
Sub SayHello()
' 定義一個(gè)變量,用于引用新建的 Workbook
Dim newWorkbook As Workbook
' 定義一個(gè)變量,用于引用新增的 Worksheet
Dim newWorksheet As Worksheet
' 定義一個(gè)工作表引用,用于引用當(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
' 新增一個(gè) Workbook,并引用
Set newWorkbook = Workbooks.Add
On Error GoTo E
' 添加一個(gè) 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" 路徑。
' 這里如果文件已存在,會(huì)提示是否覆蓋.
' 路徑要使用 '\' 進(jìn)行目錄隔離,使用'/'會(huì)報(bào)錯(cuò)
newWorkbook.SaveAs ("D:\xx.xlsx")
On Error GoTo Dispose
Dispose:
' 最后,關(guān)閉新建的 Workbook。
newWorkbook.Close
E:
End Sub
好了,讓我們?cè)囋嚦晒?,按照如下步驟操作,看看有沒有生成我們要的文件?
1. 選中我們?cè)次募幸砑拥侥繕?biāo)文件數(shù)據(jù)的那一行的任何一個(gè)單元格,如下:

2. 打開新生成的文件,可以看到數(shù)據(jù)已經(jīng)寫入了新文件


。
8. VBA如何生成并發(fā)送一個(gè)郵件?
到目前為止,雖然我們成功的生成了我們的目標(biāo)文件,但是還沒有關(guān)系到郵件發(fā)送。
本節(jié),我們將詳細(xì)討論發(fā)送郵件的過程。
首先,讓我們給我們剛開始定義的子程序SayHello改個(gè)名,叫做GenerateAttachment,如下:
Sub GenerateAttachment()
' 定義一個(gè)變量,用于引用新建的 Workbook
Dim newWorkbook As Workbook
' 定義一個(gè)變量,用于引用新增的 Worksheet
Dim newWorksheet As Worksheet
' 定義一個(gè)工作表引用,用于引用當(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
' 新增一個(gè) Workbook,并引用
Set newWorkbook = Workbooks.Add
On Error GoTo E
' 添加一個(gè) 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" 路徑。
' 這里如果文件已存在,會(huì)提示是否覆蓋.
' 路徑要使用 '\' 進(jìn)行目錄隔離,使用'/'會(huì)報(bào)錯(cuò)
newWorkbook.SaveAs ("D:\xx.xlsx")
On Error GoTo Dispose
Dispose:
' 最后,關(guān)閉新建的 Workbook。
newWorkbook.Close
E:
End Sub
那么現(xiàn)在,GenerateAttachment存在的意義,就只剩下在"D:\xx.xlsx"生成附件文件了。
接下來,讓我們?cè)贕enerateAttachment上方添加一個(gè)函數(shù),如下:
Sub SendMail()
GenerateAttachment
End Sub
從代碼我們可以看到,SendMail子程序調(diào)用了GenerateAttachment子程序,經(jīng)過測(cè)試,這樣和只有一個(gè)GenerateAttachment子程序產(chǎn)生的結(jié)果是一樣的。
那么,接下來我們?cè)趺崔k呢?
我們先創(chuàng)建一個(gè)Outlook進(jìn)程,然后創(chuàng)建一個(gè)郵件消息,然后從我們的Excel中讀取消息,設(shè)置新建郵件消息的內(nèi)容以及將之前生成的附件添加到郵件中,修改SendMail代碼如下:
Sub SendMail()
' 聲明一個(gè)引用,用于引用我們的 OutLook 實(shí)例。
Dim mailApp As Object
' 聲明引用,用于引用我們的郵件實(shí)例。
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
' 生成一個(gè)郵件信息
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,所以這里我們直接將其添加進(jìn)來
.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
試運(yùn)行,我們發(fā)現(xiàn),生成了目標(biāo)附件,并且彈出了一個(gè)Outlook新建郵件的窗口,如下:

嗯,看起來不錯(cuò),我們得到了郵件,然后我們?cè)倬庉嬁旖莘绞?,?SendMail的調(diào)用快捷方式改為 "Ctrl+r",那么每次我們選中一行數(shù)據(jù),并且按下快捷鍵的時(shí)候,就會(huì)自動(dòng)生成我們要發(fā)送的文件了。
注意:
- 這里為了演示方便,我們將生成附件的路徑寫死了,請(qǐng)根據(jù)你的實(shí)際情況修改;
- 在運(yùn)行宏的時(shí)候,有可能遇到宏被禁用的情況,這種情況下,打開Excel(xlsm)文件時(shí),在Excel上方會(huì)顯示啟用宏的提示,只要點(diǎn)擊啟用就可以了。
- 在運(yùn)行我們的程序的時(shí)候,目標(biāo)Excel(xx.xlsx)不能打開,否則會(huì)導(dǎo)致生成附件失敗。
9. 發(fā)送郵件過程總述
好了,我們總結(jié)一下使用Excel發(fā)送郵件的主流程:
- 使用 Workbooks.Add 方法,新建一個(gè)Excel附件工作簿;
- 使用 newWorkbook.Sheets.Add 方法,新增一個(gè)工作表;
- 使用 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)用,生成一個(gè)Outlook進(jìn)程對(duì)象;
- 使用 mailApp.CreateItem(olMailItem)調(diào)用,生成一個(gè)郵件對(duì)象;
- 分別設(shè)置郵件對(duì)象的屬性;
- 調(diào)用mail.Display顯示郵件或者調(diào)用mail.Send發(fā)送郵件;
到了最后,我們的全部代碼如下:
Sub SendMail()
' 聲明一個(gè)引用,用于引用我們的 OutLook 實(shí)例。
Dim mailApp As Object
' 聲明引用,用于引用我們的郵件實(shí)例。
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
' 生成一個(gè)郵件信息
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,所以這里我們直接將其添加進(jìn)來
.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()
' 定義一個(gè)變量,用于引用新建的 Workbook
Dim newWorkbook As Workbook
' 定義一個(gè)變量,用于引用新增的 Worksheet
Dim newWorksheet As Worksheet
' 定義一個(gè)工作表引用,用于引用當(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
' 新增一個(gè) Workbook,并引用
Set newWorkbook = Workbooks.Add
On Error GoTo E
' 添加一個(gè) 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" 路徑。
' 這里如果文件已存在,會(huì)提示是否覆蓋.
' 路徑要使用 '\' 進(jìn)行目錄隔離,使用'/'會(huì)報(bào)錯(cuò)
newWorkbook.SaveAs ("D:\xx.xlsx")
On Error GoTo Dispose
Dispose:
' 最后,關(guān)閉新建的 Workbook。
newWorkbook.Close
E:
End Sub
最后的最后,不要忘了關(guān)注公眾號(hào)[編程之路漫漫],碼途求知己,天涯覓一心。

