利用VBA操作OutLook批量发送工资条

最近帮朋友做了类似功能，利用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批量发送工资条相关推荐

python批量发送工资条邮件
python批量发送工资条邮件工资excel表格格式如下所示: 使用python批量给每位员工发送工资条信息,格式如下: 思路: 首先是加载excel,获取当前sheet表格 salay = loa ...
利用VBA将Outlook邮件的信息存入数据库，批量下载附件并重命名
1.打开OutLook,用ALT+F11打开VBA编辑器 2.插入以下代码: Private Sub Application_NewMail()Dim myOlApp As ApplicationDi ...
VBA使用Outlook自动发送邮件
↓↓↓欢迎关注我的公众号,在这里有数据相关技术经验的优质原创文章↓↓↓ 基础版本–能自动发送就是成功利用VBA使用Outlook自动发送邮件,代码及注释如下: Sub send_mail()Dim ...
利用VBA快速整合多个excel文件
心得(一):关于VBA如何把同一个文件下的所有文件的内容合并到同一个excel文件下问题:如何把多个格式相同的excel整合到一个excel上,起初想的是可以直接用复制粘贴--但是文件有几百个将近一 ...
vba 添加outlook 签名_利用VBA发送附件电子邮件
大家好,我们今日讲解"利用VBA发送附件电子邮件",这节内容是"VBA信息获取与处理"教程中第五个专题"利用VBA发送电子邮件"的第一节. ...
Excel 2010 VBA 入门 102 利用VBA批量发送邮件
目录示例代码 CDO组件 CDO. Message. Configuration对象前期绑定与后期绑定 New关键字创建对象添加邮件的附件示例如图所示,该表为某公司员工工资单.现需要将该表 ...
sql 发送邮件网络附件_利用VBA发送附件电子邮件
大家好,我们今日讲解"利用VBA发送附件电子邮件",这节内容是"VBA信息获取与处理"教程中第五个专题"利用VBA发送电子邮件"的第一节. ...
如何利用VBA批量更改Excel文件的内容
心得(5):利用VBA批量更改Excel文件的内容问题:因为接受的所有Excel文件都是相同格式的,但是有个单元格的内容就是需要,主办方来更改,如下所示: 获奖级别,得由主办方来更改,但是如果一个一 ...
Excel 2010 VBA 入门 103 利用VBA批量插入图片
目录示例代码: Shapes.Shape和 ShapeRange Shapes对象插入图形的方法 Excel的坐标图形大小的调整获取图片的原始大小将图片按比例缩放至单元格图片批量插入的步骤 ...
利用word2010中的“邮件”功能批量发送邀请函
在日常办公中,无论是销售部.行政人力部.市场部都会涉及到一项工作,那就是群发邀请函或者通知.公告等公文.我们可能会发送电子邀请函,也可能需要我们打印纸质邀请函,也会遇到打印大量的客户通信地址用来派发礼 ...

利用VBA操作OutLook批量发送工资条

利用VBA操作OutLook批量发送工资条相关推荐

最新文章

热门文章