最近幫朋友做了類似功能，利用VBA操作OutLook批量發送工資條，極大節省了人力。正好來總結一下，希望為大家所用。（本篇文章默認讀者電腦已經可以進行手動發送郵件，不講解OutLook如何配置郵箱，設置發件人等信息）

?

?

?

先扔框架模板：VBA操作OutLook有一套固定的代碼模板，可根據具體需求修改即可。

?

?

>>>>

發送郵件完整模板

?

?

Sub?SendMail()Set?myOlApp?=?CreateObject("Outlook.Application")'//后期綁定Set?objMail?=?myOlApp.CreateItem(olMailItem)'新建一封郵件With?objMail.To?=?"2199648674@qq.com"'//收件人.Subject?=?"郵件主題" '//就是郵件標題.Body?=?"郵件正文內容"?'//正文具體內容.cc?=?"vbatoday@163.com"?'//郵件抄送人'.BodyFormat?=?olFormatHTML??'//設置郵件格式?是否html?格式的，注意，在Excel中引用OutLook的時候，該參數要寫成數字2'.HTMLBody?=RangetoHTML(單元格對象) '//RangetoHTML是自定義函數，見下面。.Attachments.Add?"C:\Users\Administrator\Desktop\派送單.xlsx"?'//添加附件.Display?'//刷新顯示效果的作用.Send'//發送End?With End?Sub

?

幾點注意事項：

①Display作用是把上述所有操作完成后，刷新顯示OutLook軟件界面，可以理解為預覽?？墒÷?。

②.BodyFormat?=?olFormatHTML這塊注意，因為是Excel操作OutLook，所以不能直接寫屬性名稱，而要替換成數字代號，否則會出錯。正確寫法：.BodyFormat?=?2

這個2怎么得到的？去OutLook軟件里面，Msgbox olFormatHTML。Word VBA也講過類似注意點。

③BodyFormat=2和HTMLBody是同時出現的。

?

?

?

?

>>>>

將表格內容轉換為html格式的自定義函數

！！！需要注意的是：Excel默認情況下，網格線不會被識別。只有人為設置了邊框線后，用該函數轉化過，才會顯示邊框線。

Public?Function?RangetoHTML(rng?As?Range)Dim?fso?As?ObjectDim?ts?As?ObjectDim?TempFile?As?StringDim?TempWB?As?WorkbookTempFile?=?Environ$("temp")?&?"/"?&?Format(Now,?"dd-mm-yy?h-mm-ss")?&?".htm"rng.CopySet?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).SelectApplication.CutCopyMode?=?FalseOn?Error?Resume?Next.DrawingObjects.Visible?=?True.DrawingObjects.DeleteOn?Error?GoTo?0End?WithWith?TempWB.PublishObjects.Add(?_SourceType:=xlSourceRange,?_Filename:=TempFile,?_Sheet:=TempWB.Sheets(1).Name,?_Source:=TempWB.Sheets(1).UsedRange.Address,?_HtmlType:=xlHtmlStatic).Publish?(True)End?WithSet?fso?=?CreateObject("Scripting.FileSystemObject")Set?ts?=?fso.GetFile(TempFile).OpenAsTextStream(1,?-2)RangetoHTML?=?ts.ReadAllts.CloseRangetoHTML?=?Replace(RangetoHTML,?"align=center?x:publishsource=",?_"align=left?x:publishsource=")TempWB.Close?savechanges:=FalseKill?TempFileSet?ts?=?NothingSet?fso?=?NothingSet?TempWB?=?Nothing End?Function

?

?

?

直接上實戰例子：案例里面郵箱均是作者小號，歡迎騷擾。

?

>>>>

以附件形式發送工資條

?

把每個人的工資條導出為圖片，添加為附件發送。

模板頁純粹是為了粘貼數據導出圖片，沒有特殊含義

?

?

?

?

?

?

Sub?SendMail()Set?sht1?=?Worksheets("郵件頁")Set?sht2?=?Worksheets("模板頁")sht1.Range("a1:d1").Copy?sht2.Range("a1")For?Each?rng?In?sht1.Range("a2:a"?&?sht1.Cells(Rows.Count,?1).End(3).Row)rng.Resize(1,?4).Copy?sht2.Range("a2")Set?rng2?=?sht2.Range("a1:d2")sht2.Range("a1:d2").CopyPicture?Appearance:=xlScreen,?Format:=xlBitmap?'把選擇范圍內容轉化為截屏圖片信息With?ActiveSheet.ChartObjects.Add(0,?0,?rng2.Width?+?1,?rng2.Height?+?1).Chart?'在A1處按圖片尺寸稍大建立1個空白圖表對象.Paste?'把剛才截屏的圖片信息粘貼上去.Export?ThisWorkbook.Path?&?"\"?&?rng?&?".png",?"PNG"??'按指定圖片路徑及名稱導出png格式圖片……這個對于純數據工作表來說更好.Parent.Delete?'刪去該臨時增加的圖表對象End?WithNextSet?myOlApp?=?CreateObject("Outlook.Application")Set?objMail?=?myOlApp.CreateItem(olMailItem)For?a?=?2?To?sht1.Cells(Rows.Count,?1).End(3).RowSet?objMail?=?myOlApp.CreateItem(olMailItem)With?objMail.To?=?sht1.Cells(a,?5).Value?'//收件人.Subject?=?"工資明細"?'//主題.Body?=?"這是您本月的工資明細"?'//正文具體內容.Attachments.Add?ThisWorkbook.Path?&?"\"?&?sht1.Cells(a,?1)?&?".png"?'//添加附件.sendEnd?WithSet?objMail?=?NothingNextMsgBox?"發送完成！" End?Sub

?

?

QQ郵箱發送效果

?

?

?

?

?

?

>>>>

以HTML形式發送工資條

?

?

Sub?SendMail2()Set?sht1?=?Worksheets("郵件頁")Set?sht2?=?Worksheets("模板頁")sht1.Range("a1:d1").Copy?sht2.Range("a1")For?Each?rng?In?sht1.Range("a2:a"?&?sht1.Cells(Rows.Count,?1).End(3).Row)rng.Resize(1,?4).Copy?sht2.Range("a2")Set?myOlApp?=?CreateObject("Outlook.Application")Set?objMail?=?myOlApp.CreateItem(olMailItem)With?objMail.To?=?Cells(rng.Row,?5).Value?'//收件人.Subject?=?"工資明細"?'//主題.BodyFormat?=?2.HTMLBody?=?RangetoHTML(sht2.Range("a1:d2")).display.sendEnd?WithSet?objMail?=?NothingNextMsgBox?"發送完成！" End?SubPublic?Function?RangetoHTML(rng?As?Range)Dim?fso?As?ObjectDim?ts?As?ObjectDim?TempFile?As?StringDim?TempWB?As?WorkbookTempFile?=?Environ$("temp")?&?"/"?&?Format(Now,?"dd-mm-yy?h-mm-ss")?&?".htm"rng.CopySet?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).SelectApplication.CutCopyMode?=?FalseOn?Error?Resume?Next.DrawingObjects.Visible?=?True.DrawingObjects.DeleteOn?Error?GoTo?0End?WithWith?TempWB.PublishObjects.Add(?_SourceType:=xlSourceRange,?_Filename:=TempFile,?_Sheet:=TempWB.Sheets(1).Name,?_Source:=TempWB.Sheets(1).UsedRange.Address,?_HtmlType:=xlHtmlStatic).Publish?(True)End?WithSet?fso?=?CreateObject("Scripting.FileSystemObject")Set?ts?=?fso.GetFile(TempFile).OpenAsTextStream(1,?-2)RangetoHTML?=?ts.ReadAllts.CloseRangetoHTML?=?Replace(RangetoHTML,?"align=center?x:publishsource=",?_"align=left?x:publishsource=")TempWB.Close?savechanges:=FalseKill?TempFileSet?ts?=?NothingSet?fso?=?NothingSet?TempWB?=?Nothing End?Function

?

?QQ郵箱發送效果

?

?

這兩種批量發送郵件的方法基本能滿足九成以上人的需求，再復雜的，不再深入研究。

總結

以上是生活随笔為你收集整理的利用VBA操作OutLook批量发送工资条的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。