企业制作工资表利用Excel+outlook批量快速发送电子邮件Word下载.docx

企业制作工资表利用Excel+outlook批量快速发送电子邮件Word下载.docx

《企业制作工资表利用Excel+outlook批量快速发送电子邮件Word下载.docx》由会员分享，可在线阅读，更多相关《企业制作工资表利用Excel+outlook批量快速发送电子邮件Word下载.docx（21页珍藏版）》请在冰豆网上搜索。

<

/td>

/tr>

tdwidth="

25%"

薪酬等级

[==2==]

稿费、其它

[==3==]

薪档

[==4==]

岗位津贴

[==6==]

基本工资

应发合计

岗位工资

扣公积金

补贴

扣统筹保险

工龄工资

扣医疗保险

特补、独子

扣失业保险

加班费

计税工资

事假等扣款

扣税金

2"

50%"

实发合计

/tbody>

/table>

感谢你的辛勤工作。

准备待发送的数据：

a.）打开Excel，新建Book1.xlsx

b.）填入下面的内容，

第一列：

接收人，第二列：

邮件标题，第三列：

正文，第四列：

附件路径

注意：

附件路径中可以有中文，但是不能有空格

这里你可以写更多内容，每一行作为一封邮件发出。

邮件正文是黑白文本内容，不支持加粗、字体颜色等。

（如果你需要支持彩色的邮件，后面将会给出解决办法）

2.编写宏发送邮件

a.）Alt+F11打开宏编辑器，菜单中选：

插入->

模块

b.）将下面的代码粘贴到模块代码编辑器中：

‘代码list-1

[vb]viewplaincopyprint?

1.PublicDeclareFunctionSetTimerLib"

user32"

_

2.（ByValhwndAsLong,ByValnIDEventAsLong,ByValuElapseAsLong,ByVallpTimerfuncAsLong）AsLong

3.PublicDeclareFunctionKillTimerLib"

4.（ByValhwndAsLong,ByValnIDEventAsLong）AsLong

5.PrivateDeclareSubSleepLib"

kernel32"

（ByValdwMillisecondsAsLong）

6.

7.

8.

9.FunctionWinProcA（ByValhwndAsLong,ByValuMsgAsLong,ByValidEventAsLong,ByValSysTimeAsLong）AsLong

10.KillTimer0,idEvent

11.DoEvents

12.Sleep100

13.'

使用Alt+S发送邮件，这是本文的关键之处，免安全提示自动发送邮件全靠它了

14.Application.SendKeys"

%s"

15.EndFunction

16.

17.

18.'

发送单个邮件的子程序

19.SubSendMail（ByValto_whoAsString,ByValsubjectAsString,ByValbodyAsString,ByValattachementAsString）

20.DimobjOLAsObject

21.DimitmNewMailAsObject

22.'

引用MicrosoftOutlook对象

23.SetobjOL=CreateObject（"

Outlook.Application"

）

24.SetitmNewMail=objOL.CreateItem（olMailItem）

25.WithitmNewMail

26..subject=subject'

主旨

27..body=body'

正文本文

28..To=to_who'

收件者

29..Attachments.Addattachement'

附件，如果你不需要发送附件，可以把这一句删掉即可，Excel中的第四列留空，不能删哦

30..Display'

启动Outlook发送窗口

31.SetTimer0,0,0,AddressOfWinProcA

32.EndWith

33.SetobjOL=Nothing

34.SetitmNewMail=Nothing

35.EndSub

36.

37.

38.

39.

40.'

批量发送邮件

41.SubBatchSendMail（）

42.DimrowCount,endRowNo

43.endRowNo=Cells（1,1）.CurrentRegion.Rows.Count

44.'

逐行发送邮件

45.ForrowCount=1ToendRowNo

46.SendMailCells（rowCount,1）,Cells（rowCount,2）,Cells（rowCount,3）,Cells（rowCount,4）

47.Next

48.EndSub

PublicDeclareFunctionSetTimerLib"

_

（ByValhwndAsLong,ByValnIDEventAsLong,ByValuElapseAsLong,ByVallpTimerfuncAsLong）AsLong

PublicDeclareFunctionKillTimerLib"

（ByValhwndAsLong,ByValnIDEventAsLong）AsLong

PrivateDeclareSubSleepLib"

（ByValdwMillisecondsAsLong）

FunctionWinProcA（ByValhwndAsLong,ByValuMsgAsLong,ByValidEventAsLong,ByValSysTimeAsLong）AsLong

KillTimer0,idEvent

DoEvents

Sleep100

'

使用Alt+S发送邮件，这是本文的关键之处，免安全提示自动发送邮件全靠它了

Application.SendKeys"

EndFunction

'

发送单个邮件的子程序

SubSendMail（ByValto_whoAsString,ByValsubjectAsString,ByValbodyAsString,ByValattachementAsString）

DimobjOLAsObject

DimitmNewMailAsObject

引用MicrosoftOutlook对象

SetobjOL=CreateObject（"

）

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

1.'

2.SubSendMail（ByValto_whoAsString,ByValsubjectAsString,ByValbodyAsString,ByValattachementAsString）

3.DimobjOLAsObject

4.DimitmNewMailAsObject

5.'

6.SetobjOL=CreateObject（"

7.SetitmNewMail=objOL.CreateItem（olMailItem）

8.WithitmNewMail

9..subject=subject'

10.'

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

11..HTMLbody=body'

正文本文，仅仅这一行跟前面不同，其余都是一样的哦~

12.'

13..To=to_who'

14..Attachments.Addattachement'

附件

15..Display'

16.SetTimer0,0,0,AddressOfWinProcA

17.EndWithSetobjOL=Nothing

18.SetitmNewMail=NothingEndSub

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

.HTMLbody=body'

正文本文，仅仅这一行跟前面不同，其余都是一样的哦~

附件

SetTimer0,0,0,AddressOfWinProcA

EndWithSetobjOL=Nothing

SetitmNewMail=NothingEndSub

第二步：

修改excel第三列（C列）的内容，这需要你懂一点点HTML语言

例如，希望在邮件中将“报税单”三个字变红，加粗，则将第三列的内容修改为：

您好，下面是这一周的<

报税单<

，…

最终效果如图：

去发件箱里看看效果吧：

在Excel里面编辑正文，进行加粗、加颜色的操作不会生效哦。

必须用HTML自己来

2.如何替换正文部分内容

分两步：

1.换Excel内容

2.换代码

1.换Excel内容：

将变化的部分用[==xxxx==]这样的形式替换掉。

中间没有空格。

例如上图，数字[==1==]会被E列的内容替换掉，[==2==]会被F列的内容替换掉，依此类推，如果有更多，就添加更多列，[==3==],[==4==]等等。

2.换代码，将"

批量发送邮件"

这一段程序完全替换成下面的代码：

2.SubBatchSendMail（）

3.DimrowCount,endRowNo

4.DimnewBody

5.DimreplaceCount,maxReplaceCount

6.Dimpattern

7.endRowNo=Cells（1,1）.CurrentRegion.Rows.Count

9.'

10.ForrowCount=1ToendRowNo

11.'

替换当前行模板内容

12.maxReplaceCount=2'

有几处替换就写几，例子中有两处，就写2

13.newBody=Cells（rowCount,3）

14.

15.ForreplaceCount=1TomaxReplaceCount

16.pattern="

[=="

&

CStr（replaceCount）&

"

==]"

17.newBody=WorksheetFunction.Substitute（newBody,pattern,Cells（rowCount,4+replaceCount））

18.Next

19.'

替换好了，发邮件咯！

20.SendMailCells（rowCount,1）,Cells（rowCount,2）,newBody,Cells（rowCount,4）

21.

22.Next

23.EndSub

DimnewBody

DimreplaceCount,maxReplaceCount

Dimpattern

替换当前行模板内容

maxReplaceCount=2'

有几处替换就写几，例子中有两处，就写2

newBody=Cells（rowCount,3）

ForreplaceCount=1TomaxReplaceCount

pattern="

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==]来代表。

在实际应用场景中可能需要发送多封附件，其实很简单，将SendMail子程序修改成下面的样子即可：

5.Dimattaches

6.Dimattach

8.'

9.SetobjOL=CreateObject（"

10.SetitmNewMail=objOL.CreateItem（olMailItem）

11.WithitmNewMail

12..subject=subject'

13..HTMLbody=body'

14..To=to_who'

16.attaches