利用Excel批量快速发送电子邮件Word文档格式.docx
《利用Excel批量快速发送电子邮件Word文档格式.docx》由会员分享，可在线阅读，更多相关《利用Excel批量快速发送电子邮件Word文档格式.docx（12页珍藏版）》请在冰豆网上搜索。
b.）将下面的代码粘贴到模块代码编辑器中：
‘代码list-1
PublicDeclareFunctionSetTimerLib"
user32"
_
（ByValhwndAsLong,ByValnIDEventAsLong,ByValuElapseAsLong,ByVallpTimerfuncAsLong）AsLong
PublicDeclareFunctionKillTimerLib"
（ByValhwndAsLong,ByValnIDEventAsLong）AsLong
PrivateDeclareSubSleepLib"
kernel32"
（ByValdwMillisecondsAsLong）
FunctionWinProcA（ByValhwndAsLong,ByValuMsgAsLong,ByValidEventAsLong,ByValSysTimeAsLong）AsLong
KillTimer0,idEvent
DoEvents
Sleep100
'
使用Alt+S发送邮件，这是本文的关键之处，免安全提示自动发送邮件全靠它了
Application.SendKeys"
%s"
EndFunction
'
发送单个邮件的子程序
SubSendMail（ByValto_whoAsString,ByValsubjectAsString,ByValbodyAsString,ByValattachementAsString）
DimobjOLAsObject
DimitmNewMailAsObject
引用MicrosoftOutlook对象
SetobjOL=CreateObject（"
Outlook.Application"
）
SetitmNewMail=objOL.CreateItem（olMailItem）
WithitmNewMail
.subject=subject'
主旨
.body=body'
正文本文
.To=to_who'
收件者
.Attachments.Addattachement'
附件，如果你不需要发送附件，可以把这一句删掉即可，Excel中的第四列留空，不能删哦
.Display'
启动Outlook发送窗口
SetTimer0,0,0,AddressOfWinProcA
EndWith
SetobjOL=Nothing
SetitmNewMail=Nothing
EndSub
批量发送邮件
SubBatchSendMail（）
DimrowCount,endRowNo
endRowNo=Cells（1,1）.CurrentRegion.Rows.Count
逐行发送邮件
ForrowCount=1ToendRowNo
SendMailCells（rowCount,1）,Cells（rowCount,2）,Cells（rowCount,3）,Cells（rowCount,4）
Next
最终代码编辑器中的效果如下图：
i
为了正确执行代码，你还需要在
菜单中选择：
工具->
引用中的MicroseftOutlookX.0ObjectLibrary
勾选上（X.0是版本号，不同机器可能不一样）
c.）粘贴好代码、勾选上上面的东东后可以发送邮件了，点击上图A红圈所示的绿色三角按钮，会弹出下图所示的对话框，点运行，就开始批量发送邮件了。
d.）如果你想确认你的邮件是否都发出去了，可以去Outlook的“已发送邮件”文件夹中查看，是否有你希望发出的邮件，如果有，恭喜你，收工~~
---------------------------------------------------------------------
下面讲解
1.如何发送彩色的邮件
2.如何替换正文中的部分内容，例如，每一封邮件中可能最开始的称呼不同，给对方报出的数字不同等
3.如何发送多附件
1.
如何发送彩色邮件
发送彩色邮件需要两步，
第一步：
上面的代码需要改一句（红色加粗文本，body改成HTMLBody）：
‘代码list-2
.subject=subject
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
.HTMLbody=body
正文本文，仅仅这一行跟前面不同，其余都是一样的哦~
.To=to_who
附件
.Display
SetTimer0,0,0,AddressOfWinProcA
EndWith
SetitmNewMail=NothingEndSub
第二步：
修改excel第三列（C列）的内容，这需要你懂一点点HTML语言
例如，希望在邮件中将“报税单”三个字变红，加粗，则将第三列的内容修改为：
您好，下面是这一周的<
fontcolor="
red"
>
<
b>
报税单<
/b>
/font>
，…
最终效果如图：
去发件箱里看看效果吧：
在Excel里面编辑正文，进行加粗、加颜色的操作不会生效哦。
必须用HTML自己来，sorry哦
不会HTML的朋友可以新浪微博follow我帮忙：
@研究员Raywill
2.
如何替换正文部分内容
分两步：
1.换Excel内容
2.换代码
1.换Excel内容：
将变化的部分用[==xxxx==]这样的形式替换掉。
中间没有空格。
例如上图，数字[==1==]会被E列的内容替换掉，[==2==]会被F列的内容替换掉，依此类推，如果有更多，就添加更多列，[==3==],[==4==]等等。
2.换代码，将"
批量发送邮件"
这一段程序完全替换成下面的代码：
DimnewBody
DimreplaceCount,maxReplaceCount
Dimpattern
替换当前行模板内容
maxReplaceCount=2'
有几处替换就写几，例子中有两处，就写2
newBody=Cells（rowCount,3）
ForreplaceCount=1TomaxReplaceCount
pattern="
[=="
&
CStr（replaceCount）&
"
==]"
newBody=WorksheetFunction.Substitute（newBody,pattern,Cells（rowCount,4+replaceCount））
替换好了，发邮件咯！
SendMailCells（rowCount,1）,Cells（rowCount,2）,newBody,Cells（rowCount,4）
上面“maxReplaceCount=2"
这一行代码，2需要改成你自己的值，替换几个地方就写几（新添加了几个列就写几）上面添加了E、F两列，就是2，如果你添加了3处替换（E、F、G列），就写3.
不过，对于需要重复替换的内容，不需要添加新列，例如，《大话西游》在邮件中出现了两次，可以重复使用[==2==]来代表。
3.
如何发送多附件
在实际应用场景中可能需要发送多封附件，其实很简单，将SendMail子程序修改成下面的样子即可：
Dimattaches
Dimattach
.HTMLbody=body'
attaches=Split（attachement,"
;
"
ForEachattachInattaches
If（Len（attach）>
0）Then
.Attachments.Addattach
EndIf
在Excel的附件列（第三列），多个附件用半角的分号分隔开（是”;
，不是”；
“），例如：
c:
\doc\毕业证书附件.jpg;
\doc\校方证明书.docx
最终代码如下：
汇总了批量替换、彩色邮件、多附件功能
参考文献：
本文发送邮件过程中不会弹出安全提示框，发件速度极快；
网友反馈：
∙发件人：
angel3814
∙时间：
2013-01-2810:
35:
30
您好，经过测试，该方法对于大量发送邮件（大于100封。
几十封没有问题。
）有一些问题，因为程序必须在建立完成所有word发送窗口后，才会统一alt+S发送，很容易造成内存不足，并且，最后的alt+S便不再执行，在实际应用中，我只能再写一个按钮，每次发送5封，发送完成计数+5，手工再点；
想跟您请教，是否能有更好的改进方法？
非常感谢angel3814提供的解决方案：
DimrowCount,endRowNo,csheetAsWorksheet,ssheetAsWorksheet,iAsInteger,jAsInteger
Setcsheet=Worksheets（"
邮件内容"
Setssheet=Worksheets（"
发送"
i=ssheet.Cells（2,1）.Value
j=ssheet.Cells（2,2）.Value
ForrowCount=iToj
SendMailcsheet.Cells（rowCount,1）,csheet.Cells（rowCount,2）,csheet.Cells（rowCount,3）,csheet.Cells（rowCount,4）
ssheet.Cells（2,1）.Value=i+5
ssheet.Cells（2,2）.Value=j+5
点一次，自动+5，再点
之所以用5，是测试发现，10以上，就有很大几率alt+S事件不生效（可能还是延迟问题？
====
另外，对于希望批量发送邮件的同学，可以不用把思维局限在Outlook上。
如果你知道公司的邮件服务器的pop3地址，不妨用命令行工具来实现邮件的批量自动发送。
例如：
Blat：
先用任意工具将一封封的邮件准备好，保存为一个个文本文件，然后用Blat逐个循环发送即可。
版权声明：
本文为博主原创文章，未经博主允许不得转载。
∙上一篇OceanBaseJoin操作
∙下一篇对比MessagePack和ProtocalBuffer
升级会员 