利用Excel批量快速发送电子邮件Word文件下载.docx
- 文档编号:19548733
- 上传时间:2023-01-07
- 格式:DOCX
- 页数:13
- 大小:171.71KB
利用Excel批量快速发送电子邮件Word文件下载.docx
《利用Excel批量快速发送电子邮件Word文件下载.docx》由会员分享,可在线阅读,更多相关《利用Excel批量快速发送电子邮件Word文件下载.docx(13页珍藏版)》请在冰豆网上搜索。
4
这里你可以写更多内容,每一行作为一封邮件发出。
邮件正文是黑白文本内容,不支持加粗、字体颜色等。
(如果你需要支持彩
色的邮件,后面将会给出解决办法)
2.编写宏发送邮件
a.)Alt+F11打开宏编辑器,菜单中选:
插入->
模块
b.)将下面的代码粘贴到模块代码编辑器中:
,代码list-1
PublicDeclareFunctionSetTimerLib"
user32"
_
(ByVaihwndAsLong,ByVainIDEventAsLong,ByVaiuElapseAsLong,
ByVaiIpTimerfuncAsLong)AsLong
PublicDeclareFunctionKillTimerLib"
(ByVaihwndAsLong,ByValnIDEventAsLong)AsLong
PrivateDeclareSubSleepLib"
kerneI32"
(ByValdwMillisecondsAsLong)
FunctionWinProcA(ByVaihwndAsLong,ByValuMsgAsLong,ByValidEvent
AsLong,ByVaiSysTimeAsLong)AsLong
KillTimer0,idEvent
DoEvents
Sleep100
'
使用Alt+S发送邮件,这是本文的关键之处,免安全提示自动发送邮件全靠它了
Application.SendKeys"
%s"
EndFunction
发送单个邮件的子程序
SubSendMaii(ByVaito_whoAsString,ByValsubjectAsString,ByValbody
AsString,ByValattachementAsString)
DimobjOLAsObject
DimitmNewMailAsObject
引用MicrosoftOutlook对象
SetobjOL=CreateObject("
Outlook.Application"
)
SetitmNewMail=objOL.Createltem(olMailltem)
WithitmNewMail
.subject=subject'
主旨
.body=body'
正文本文
.To=to_who'
收件者
.Attachments.Add
attachement'
附件,如果你不需要发送附件,可以把这一句删掉即可,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
最终代码编辑器中的效果如下图:
文件旧礎⑥视图(V)搖人
馮试⑪运行迪TMCD外接程序(A)§
C(Wj帮助凹
发送单个娜件的子理库
SubSendM^辽伯艸&
1to_wha丸三String,ByV&
lsutject辰StringDimobjOLAsObjact
DinitmN&
wM^ilAsObject
f引用MicrosoftOutleok对象
23
SietobjHL=CreateObject(*0ntlook.Application^}
SetittmHnVai.1-objOL.CraataTtan(olJIulItfinlWith
.suljsct=subject_'
body二Sody
.To-towho
为了正确执行代码,你还需要在
菜单中选择:
工具->引用中的
MicroseftOutlookX.OObject
Library勾选上(X.O是版本号,
不同机器可能不一样)
c.)粘贴好代码、勾选上上面的东东后可以发送邮件了,点击上图A红圈所示的
绿色三角按钮,会弹出下图所示的对话框,点运行,就开始批量发送邮件了。
d.)如果你想确认你的邮件是否都发出去了,可以去Outlook的已发送邮件”文件
夹中查看,是否有你希望发出的邮件,如果有,恭喜你,收工~~
下面讲解
1.如何发送彩色的邮件
2.如何替换正文中的部分内容,例如,每一封邮件中可能最开始的称呼不同,给对
方报出的数字不同等
3.如何发送多附件
1.如何发送彩色邮件
发送彩色邮件需要两步,
第一步:
上面的代码需要改一句(红色加粗文本,body改成
HTMLBody):
,代码list-2
SubSendMail(ByValto_whoAsString,ByValsubjectAsString,ByValbodyAsString,ByValattachementAsString)
主旨
.HTMLbody=body'
正文本文,仅仅这一行跟前面不同,其余都是一样的哦~
收件者
.Attachments.Addattachement'
附件
启动Outlook发送窗口
EndWithSetobjOL=Nothing
SetitmNewMail=NothingEndSub
第二步:
修改excel第三列(C列)的内容,这需要你懂一点点HTML语言
例如,希望在邮件中将报税单”三个字变红,加粗,则将第三列的内容修改为:
您好,下面是这一周的vfontcolor="
red"
>
<
b>
报税单<
/b>
v/font>
,…
去发件箱里看看效果吧:
I.
痘住对国:
2012/10/31園三)20:
12
收伴人
t&
x@chiiLatax.cn*
kb]
下面是这周的报税单,…
最终效果如图:
在Excel里面编辑正文,进行加粗、加颜色的操作不会生效哦。
必须用HTML自己来,sorry哦不会HTML的朋友可以新浪微博follow我帮忙:
@研究员Raywill
2.如何替换正文部分内
分两步:
1.换Excel内容
2.换代码
1.换Excel内容:
B
F
caicai@aa・com
到货提酹您好[=-!
==],您购买的[=2=]已经到货。
\htt匚小菜
《格列夫
1ack@taobao.com.
到货提產您好[==!
==],您购买的[==2=]已经到货。
\lrt灯
n—
—」厶
竄大话西
将变化的部分用[==xxxx==]这样的形式替换掉。
中间没有空格。
例如上图,数字[==仁=]会被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==]来代表。
\httf云《大话西游》
子程序修改
ByValbody
在实际应用场景中可能需要发送多封附件,其实很简单,将SendMail
成下面的样子即可:
SubSendMail(ByValto_whoAsString,ByValsubjectAsString,
Dimattaches
Dimattach
attaches=Split(attachement,"
;
"
ForEachattachInattaches
If(Len(attach)>
0)Then
.Attachments.Addattach
EndIf
在Excel的附件列(第三列),多个附件用半角的分号分隔开(是”;
不是”;
“,例如:
毕业证书附件校方证明书.docx
最终代码如下:
汇总了批量替换、彩色邮件、多附件功能
PublicDeclareFunctionSetTimerLib"
(ByValhwndAsLong,ByValnIDEventAsLong)AsLong
kernel32"
(ByValdwMillisecondsAsLong)
FunctionWinProcA(ByValhwndAsLong,ByValuMsgAsLong,ByValidEventAsLong,ByValSysTimeAsLong)AsLong
Application.SendKeys"
SetitmNewMail=Nothing
newBody=WorksheetFunction.Substitute(newBody,pattern,
Cells(rowCount,4+replaceCount))
SendMailCells(rowCount,1),Cells(rowCount,2),newBody,
Cells(rowCount,4)
参考文献:
http:
//www.officefans.net/cdb/viewthread.php?
tid=53888
本文发送邮件过程中不会弹出安全提示框,发件速度极快;
网友反馈:
・发件人:
angel3814
«
时间:
2013-01-2810:
35:
30
您好,经过测试,该方法对于大量发送邮件(大于100封。
几十封没有问题。
)有一些问题,因为程序必须在建立完成所有word发送窗口后,才会统一alt+S发送,
很容易造成内存不足,并且,最后的alt+S便不再执行,在实际应用中,我只能再
写一个按钮,每次发送5封,发送完成计数+5,手工再点;
想跟您请教,是否能有更好的改进方法?
非常感谢angel3814提供的解决方案:
DimrowCount,endRowNo,csheetAsWorksheet,ssheetAsWorksheet,i
AsInteger,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
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 利用 Excel 批量 快速 发送 电子邮件
![提示](https://static.bdocx.com/images/bang_tan.gif)